Theory List_Supplement

(*
  Author: Fred Kurz
*)
theory List_Supplement
imports Main
begin

lemma list_foot: 
  assumes "l  []" 
  obtains y ys where "l = ys @ [y]"
proof -
  {
    assume a: "l  []"
    have "y ys. l = ys @ [y]" 
      using a 
      proof (induction l)
        case (Cons a l)
        then show ?case 
          proof (cases "l = []")
            case True
            have "[] @ [a] = a # l" 
              using True
              by simp
            thus ?thesis 
              using Cons.prems(1)
              by simp
          next
            case False
            thm Cons
            then obtain y ys where "l = ys @ [y]" 
              using Cons.IH
              by blast
            then have "a # l = a # ys @ [y]" 
              by blast
            thus ?thesis
              by fastforce
          qed
      qed simp
  }
  thus ?thesis 
    using assms that 
    by blast
qed

lemma list_ex_intersection: "list_ex (λv. list_ex ((=) v) ys) xs  set xs  set ys  {}"
proof -
  {
    assume "list_ex (λv. list_ex ((=) v) ys) xs"
    then have "v  set xs. list_ex ((=) v) ys" 
      using list_ex_iff
      by fast
    moreover have "v. list_ex ((=) v) ys = (v'  set ys. v = v')" 
      using list_ex_iff
      by blast
    ultimately have "v  set xs. (v'  set ys. v = v')"
      by blast
    then obtain v v' where "v  set xs" and "v'  set ys" and "v = v'"
      by blast
    then have "set xs  set ys  {}"
      by blast
  } moreover {
    assume  "set xs  set ys  {}"
    then obtain v v' where "v  set xs" and "v'  set ys" and "v = v'"
      by blast
    then have "list_ex (λv. v'  set ys. v = v') xs" 
      using list_ex_iff 
      by fast
    moreover have "v. (v'  set ys. v = v') = list_ex ((=) v) ys" 
      using list_ex_iff
      by blast
    ultimately have "list_ex (λv. list_ex ((=) v) ys) xs" 
      by force
  } ultimately show ?thesis
    by blast
qed

lemma length_map_upt: "length (map f [a..<b]) = b - a" 
proof -
  have "length [a..<b] = b - a" 
    using length_upt
    by blast
  moreover have "length (map f [a..<b]) = length [a..<b]"
    by simp
  ultimately show ?thesis
    by argo
qed

lemma not_list_ex_equals_list_all_not: "(¬list_ex P xs) = list_all (λx. ¬P x) xs" 
proof -
  have "(¬list_ex P xs) = (¬Bex (set xs) P)"
    using list_ex_iff 
    by blast
  also have " = Ball (set xs) (λx. ¬P x)"
    by blast 
  finally show ?thesis
    by (simp add: Ball_set_list_all)
qed

lemma element_of_subseqs_then_subset:
  assumes "l  set (subseqs l')" 
  shows"set l  set l'" 
  using assms
proof (induction l' arbitrary: l)
  case (Cons x l')
  have "set (subseqs (x # l')) = (Cons x) ` set (subseqs l')  set (subseqs l')"
    unfolding subseqs.simps(2) Let_def set_map set_append..
  then consider (A) "l  (Cons x) ` set (subseqs l')"
    | (B) "l  set (subseqs l')" 
    using Cons.prems
    by blast
  thus ?case 
    proof (cases)
      case A
      then obtain l'' where "l''  set (subseqs l')" and "l = x # l''" 
        by blast
      moreover have "set l''  set l'" 
        using Cons.IH[of l'', OF calculation(1)].
      ultimately show ?thesis 
        by auto
    next
      case B
      then show ?thesis 
        using Cons.IH
        by auto
    qed
qed simp

(* TODO rewrite using list comprehension ‹embed xs = [[x]. x ← xs]› *)
text ‹ Embed a list into a list of singleton lists. ›
primrec embed :: "'a list  'a list list" 
  where "embed [] = []" 
  | "embed (x # xs) = [x] # embed xs"

lemma set_of_embed_is: "set (embed xs) = { [x] | x. x  set xs }" 
  by (induction xs; force+)

lemma concat_is_inverse_of_embed:
  "concat (embed xs) = xs"
  by (induction xs; simp)

lemma embed_append[simp]: "embed (xs @ ys) = embed xs @ embed ys"
proof (induction xs)
  case (Cons x xs)
  have "embed (x # xs @ ys) = [x] # embed (xs @ ys)" 
    try0
    by simp
  also have " = [x] # (embed xs @ embed ys)" 
    using Cons.IH 
    by simp
  finally show ?case 
    by fastforce
qed simp

end

Theory Map_Supplement

(*
  Author: Fred Kurz
*)
theory Map_Supplement
imports Main
begin

lemma map_of_defined_if_constructed_from_list_of_constant_assignments:
  "l = map (λx. (x, a)) xs  x  set xs. (map_of l) x = Some a" 
proof (induction xs arbitrary: l)
  case (Cons x xs)
  let ?l' = "map (λv. (v, a)) xs"
  from Cons.prems(1) have "l = (x, a) # map (λv. (v, a)) xs" 
    by force
  moreover have "v  set xs. (map_of ?l') v = Some a" 
    using Cons.IH[where l="?l'"]
    by blast
  ultimately show ?case
    by auto
qed auto

― ‹ NOTE Function graph is the set of pairs (x, f x) for a (total) function f. ›
― ‹ TODO Remove the first premise (follows from the second). ›
lemma map_of_from_function_graph_is_some_if:
  fixes f :: "'a  'b"
  assumes "set xs  {}"
   and "x  set xs"
  shows "(map_of (map (λx. (x, f x)) xs)) x = Some (f x)" 
  using assms 
proof (induction xs arbitrary: f x)
  ― ‹ NOTE Base case follows trivially from violation of assumption set xs ≠ {}›. ›
  case (Cons a xs)
    thm Cons
    let ?m = "map_of (map (λx. (x, f x)) xs)" 
    have a: "map_of (map (λx. (x, f x)) (Cons a xs)) = ?m(a  f a)" 
      unfolding map_of_def
      by simp
    thus ?case 
      proof(cases "x = a")
        case False
        thus ?thesis 
        proof (cases "set xs = {}")
            ― ‹ NOTE Follows from contradiction (x ∈ set (Cons a xs) ∧ set xs = {} ∧ x ≠ a ≡ ⊥›)›
            case True
            thus ?thesis 
              using Cons.prems(2)
              by fastforce
          next
            case False
            then have "x  set xs" 
              using x  a Cons.prems(2)
              by fastforce
            moreover have "map_of (map (λx. (x, f x)) (Cons a xs)) x = ?m x"
              using x  a
              by fastforce
            ultimately show ?thesis 
              using Cons.IH[OF False]
              by presburger
          qed 
      qed force
    qed blast

lemma foldl_map_append_is_some_if:
  assumes "b x = Some y  (m  set ms. m x = Some y)" 
    and "m'  set ms. m' x = Some y  m' x = None"
  shows "foldl (++) b ms x = Some y" 
using assms
proof (induction ms arbitrary: b)
  ― ‹ NOTE Induction base case violates first assumption (we have at least one element in ms 
    and hence ms ≠ []›). ›
  case (Cons a ms)
  consider (b_is_some_y) "b x = Some y" 
    | (m_is_some_y) "m  set (a # ms). m x = Some y" 
    using Cons.prems(1)
    by blast
  hence "(b ++ a) x = Some y  (mset ms. m x = Some y)"
    proof (cases)
      case b_is_some_y
      moreover have "a x = Some y  a x = None" 
        using Cons.prems(2)
        by simp
      ultimately show ?thesis 
        using map_add_Some_iff[of b a x y]
        by blast
    next
      case m_is_some_y
      then show ?thesis 
        proof (cases "a x = Some y")
          case False 
          then obtain m where "m  set ms" and "m x = Some y" 
            using m_is_some_y try0
            by auto
          thus ?thesis
            by blast
        qed simp
    qed
  moreover have "m'  set ms. m' x = Some y  m' x = None"  
    using Cons.prems(2)
    by fastforce
  ultimately show ?case using Cons.IH[where b="b ++ a"]
    by simp
qed auto

(* TODO "∀(v, a) ∈ set l. ∀(v', a') ∈ set l. v ≠ v' ∨ a = a'" ↝
  "∀(v', a') ∈ set l. v ≠ v' ∨ a = a'" (this is too strong; we only consider (v, a), i.e. fixed v)
*)
(* TODO isn't this the same as map_of_is_SomeI? *)
lemma map_of_constant_assignments_defined_if:
  assumes "(v, a)  set l. (v', a')  set l. v  v'  a = a'"
    and "(v, a)  set l" 
  shows "map_of l v = Some a" 
  using assms
proof (induction l)
  case (Cons x l)
  thm Cons
  then show ?case 
    proof (cases "x = (v, a)")
      case False
      have v_a_in_l: "(v, a)  set l" 
        using Cons.prems(2) False
        by fastforce
      {
        have "(v, a)  set l. (v', a')  set l. v  v'  a = a'"
          using Cons.prems(1)
          by auto 
        hence "map_of l v = Some a"
          using Cons.IH v_a_in_l
          by linarith
      } note ih = this
      {
        have "x  set (x # l)" 
          by auto
        hence "fst x  v  snd x = a" 
          using Cons.prems(1) v_a_in_l
          by fastforce
      } note nb = this
      ― ‹ NOTE If @{text "fst x = v"} then @{text "snd x = a"} by fact @{text "nb"}; moreover if 
        on the other hand @{text "fst x ≠ v"}, then the proposition follows from the induction 
        hypothesis since @{text "map_of (x # l) v = map_of l v"} in that case. ›
      thus ?thesis
        using ih nb
        by (cases "fst x = v") fastforce+
    qed simp
qed fastforce

end

Theory CNF_Supplement

(*
  Author: Fred Kurz
*)
theory CNF_Supplement
  imports "Propositional_Proof_Systems.CNF_Formulas_Sema"
begin

(* TODO fix warnings *)

fun is_literal_formula 
  where "is_literal_formula (Atom _) = True"
  | "is_literal_formula (¬(Atom _)) = True" 
  | "is_literal_formula _ = False" 

fun literal_formula_to_literal :: "'a formula  'a literal"
  where "literal_formula_to_literal (Atom a) = a+"
  | "literal_formula_to_literal (¬(Atom a)) = a¯" 

lemma is_literal_formula_then_cnf_is_singleton_clause:
  assumes "is_literal_formula f"
  obtains C where "cnf f = { C }" 
proof -
  consider (f_is_positive_literal) "a. f = Atom a" 
    | (f_is_negative_literal) "a. f = ¬(Atom a)"
    using assms is_literal_formula.elims(2)[of f]
    by meson 
  then have "C. cnf f = { C }"
    proof (cases)
      case f_is_positive_literal
      then obtain a where "f = Atom a" 
        by force
      then have "cnf f = {{ a+ }}"
        by force
      thus ?thesis
        by simp
    next
      case f_is_negative_literal
      then obtain a where "f = ¬(Atom a)" 
        by force
      then have "cnf f = {{ a¯ }}"
        by force
      thus ?thesis
        by simp
    qed
  thus ?thesis 
    using that
    by presburger 
qed

lemma literal_formula_to_literal_is_inverse_of_form_of_lit: 
  "literal_formula_to_literal (form_of_lit L) = L"
  by (cases L, simp+)

lemma is_nnf_cnf: 
  assumes "is_cnf F" 
    shows "is_nnf F" 
  using assms 
proof (induction F)
  case (Or F1 F2)
  have "is_disj (F1  F2)"
    using Or.prems is_cnf.simps(5)
    by simp
  thus ?case 
    using disj_is_nnf 
    by blast
qed simp+

lemma cnf_of_literal_formula:
  assumes "is_literal_formula f" 
  shows "cnf f = {{ literal_formula_to_literal f }}"
proof -
  consider (f_is_positive_literal) "a. f = Atom a"
    | (f_is_negative_literal) "a. f = (¬(Atom a))"
    using assms is_literal_formula.elims(2)[of f "a. f = Atom a"]
       is_literal_formula.elims(2)[of f "a. f = (¬(Atom a))"]
    by blast
  thus ?thesis 
    by(cases, force+)
qed

lemma is_cnf_foldr_and_if: 
  assumes "f  set fs. is_cnf f"
  shows "is_cnf (foldr () fs (¬))" 
  using assms
proof (induction fs)
  case (Cons f fs)
  have "foldr () (f # fs) (¬) = f  (foldr () fs (¬))" 
    by simp
  moreover {
    have "f  set fs. is_cnf f" 
      using Cons.prems
      by force
    hence "is_cnf (foldr () fs (¬))" 
      using Cons.IH
      by blast
  }
  moreover have "is_cnf f" 
    using Cons.prems
    by simp
  ultimately show ?case
    by simp
qed simp

end

Theory CNF_Semantics_Supplement

(*
  Author: Fred Kurz
*)
theory CNF_Semantics_Supplement
  imports "Propositional_Proof_Systems.CNF_Formulas_Sema" "CNF_Supplement"
begin

lemma not_model_if_exists_unmodeled_singleton_clause:
  assumes "is_cnf F"
    and "{L}  cnf F"
    and "¬lit_semantics ν L" 
  shows "¬ν  F" 
proof (rule ccontr)
  assume "¬¬ν  F"  
  then have a: "ν  F"
    by blast
  moreover have "is_nnf F" 
    using is_nnf_cnf[OF assms(1)]
    by simp 
  moreover {
    let ?C = "{L}" 
    have "¬(L'. L'  ?C  lit_semantics ν L')" 
      using assms(3)
      by fast
    then have "¬(C  cnf F. L. L  C  lit_semantics ν L)"
      using assms(2)
      by blast
    hence "¬cnf_semantics ν (cnf F)" 
      unfolding cnf_semantics_def clause_semantics_def
      by fast
  }
  ultimately have "¬ ν  F" 
    using cnf_semantics
    by blast
  thus False 
    using a 
    by blast
qed

― ‹ NOTE This follows by contraposition from the previous lemma 
not_model_if_exists_unmodeled_singleton_clause›. ›
corollary model_then_all_singleton_clauses_modelled:
  assumes "is_cnf F"
    and "{L}  cnf F"
    and "ν  F" 
  shows "lit_semantics ν L" 
  using not_model_if_exists_unmodeled_singleton_clause[OF assms(1, 2)] assms(3)
  by blast

― ‹ NOTE This is essentially the ⇒› direction of the compactness theorem when treating CNFs as sets
of formulas (sets of disjunctions in this case). ›
lemma model_for_cnf_is_model_of_all_subsets:
  assumes "cnf_semantics ν "
    and "ℱ'  " 
  shows "cnf_semantics ν ℱ'" 
proof -
  {
    fix C
    assume "C  ℱ'"
    then have "C  " 
      using assms(2)
      by blast
    then have "clause_semantics ν C" 
      using assms(1)
      unfolding cnf_semantics_def
      by blast
  }
  thus ?thesis 
    unfolding cnf_semantics_def
    by blast
qed

lemma cnf_semantics_monotonous_in_cnf_subsets_if:
  assumes "𝒜  Φ" 
    and "is_cnf Φ" 
    and "cnf Φ'  cnf Φ" 
  shows "cnf_semantics 𝒜 (cnf Φ')"
proof -
  {
    have "is_nnf Φ"
      using is_nnf_cnf[OF assms(2)].
    hence "cnf_semantics 𝒜 (cnf Φ)" 
      using cnf_semantics assms(1)
      by blast
  }
  thus ?thesis 
    using model_for_cnf_is_model_of_all_subsets[OF _ assms(3)]
    by simp
qed

corollary modelling_relation_monotonous_in_cnf_subsets_if:
  assumes "𝒜  Φ" 
    and "is_cnf Φ" 
    and "is_cnf Φ'"
    and "cnf Φ'  cnf Φ" 
  shows "𝒜  Φ'"
proof -
  have "cnf_semantics 𝒜 (cnf Φ')" 
    using cnf_semantics_monotonous_in_cnf_subsets_if[OF assms(1, 2, 4)].
  thus ?thesis
    using cnf_semantics is_nnf_cnf[OF assms(3)]
    by blast  
qed

― ‹ NOTE Show that any clause C› containing a subset C› for which all literals
  L› evaluate to False› for the given valuation 𝒜›, then the clause
  semantics evaluation can be reduced to the set C - C'› where all literals of 
  C'› have been removed. ›
lemma lit_semantics_reducible_to_subset_if:
  assumes "C'  C"
    and "L  C'. ¬lit_semantics 𝒜 L"
  shows "clause_semantics 𝒜 C = clause_semantics 𝒜 (C - C')"
  unfolding clause_semantics_def
  using assms
  by fast

end

Theory State_Variable_Representation

(*
  Author: Mohammad Abdulaziz, Fred Kurz
*)
theory State_Variable_Representation
  imports Main "Propositional_Proof_Systems.Formulas" "Propositional_Proof_Systems.Sema" 
    "Propositional_Proof_Systems.CNF"
begin
section "State-Variable Representation"

text ‹ Moving on to the Isabelle implementation of state-variable representation, we
first add a more concrete representation of states using Isabelle maps. To this end, we add a 
type synonym \isaname{state} for maps of variables to values. 
Since maps can be conveniently constructed from lists of 
assignments---i.e. pairs (v, a) :: 'variable × 'domain›---we also add a corresponding type 
synonym \isaname{assignment}. ›

type_synonym ('variable, 'domain) state = "'variable  'domain"

type_synonym ('variable, 'domain) assignment = "'variable × 'domain"

text ‹ Effects and effect condition (see \autoref{sub:state-variable-representation}) are 
implemented in a straight forward manner using a datatype with constructors for each effect type.›

type_synonym ('variable, 'domain) Effect = "('variable × 'domain) list"

end

Theory STRIPS_Representation

(*
  Author: Mohammad Abdulaziz, Fred Kurz
*)
theory STRIPS_Representation
  imports State_Variable_Representation
begin

section "STRIPS Representation"

(*<*)
type_synonym  ('variable) strips_state = "('variable, bool) state"
(*>*)
text ‹ We start by declaring a \isakeyword{record} for STRIPS operators.
This which allows us to define a data type and automatically generated selector operations. 
\footnote{For the full reference on records see \cite[11.6, pp.260-265]{wenzel--2018}} 

The record specification given below closely resembles the canonical representation of
STRIPS operators with fields corresponding to precondition, add effects as well as delete effects.›

record  ('variable) strips_operator = 
  precondition_of :: "'variable list" 
  add_effects_of :: "'variable list" 
  delete_effects_of :: "'variable list" 

― ‹ This constructor function is sometimes a more descriptive and replacement for the record 
syntax and can moreover be helpful if the record syntax leads to type ambiguity.›
abbreviation  operator_for
  :: "'variable list  'variable list  'variable list  'variable strips_operator"
  where "operator_for pre add delete   
    precondition_of = pre
    , add_effects_of = add
    , delete_effects_of = delete " 

definition  to_precondition
  :: "'variable strips_operator  ('variable, bool) assignment list"
  where "to_precondition op  map (λv. (v, True)) (precondition_of op)" 

definition  to_effect
  :: "'variable strips_operator  ('variable, bool) Effect" 
  where "to_effect op =  [(va, True). va  add_effects_of op] @ [(vd, False). vd  delete_effects_of op]"

text ‹ Similar to the operator definition, we use a record to represent STRIPS problems and specify
fields for the variables, operators, as well as the initial and goal state. ›

record  ('variable) strips_problem =
  variables_of :: "'variable list" ("(_𝒱)" [1000] 999)
  operators_of :: "'variable strips_operator list" ("(_𝒪)" [1000] 999)
  initial_of :: "'variable strips_state" ("(_I)" [1000] 999)
  goal_of :: "'variable strips_state" ("(_G)" [1000] 999)

value  "stop" (* Tell document preparation to stop collecting for the last tag *)
(*<*)
― ‹ This constructor function is sometimes a more descriptive and replacement for the record 
syntax and can moreover be helpful if the record syntax leads to type ambiguity.›
(* TODO change identifier gs ~> G *)
abbreviation problem_for 
  :: "'variable list 
   'variable strips_operator list 
   'variable strips_state 
   'variable strips_state
   ('variable) strips_problem"
  where "problem_for vs ops I gs   
    variables_of = vs
    , operators_of = ops
    , initial_of = I
    , goal_of = gs " 

type_synonym ('variable) strips_plan = "'variable strips_operator list"

type_synonym ('variable) strips_parallel_plan = "'variable strips_operator list list"

definition is_valid_operator_strips
  :: "'variable strips_problem  'variable strips_operator  bool"
  where "is_valid_operator_strips Π op  let 
      vs = variables_of Π 
      ; pre = precondition_of op
      ; add = add_effects_of op
      ; del = delete_effects_of op
    in list_all (λv. ListMem v vs) pre 
     list_all (λv. ListMem v vs) add
     list_all (λv. ListMem v vs) del
     list_all (λv. ¬ListMem v del) add
     list_all (λv. ¬ListMem v add) del"

definition "is_valid_problem_strips Π
   let ops = operators_of Π
      ; vs = variables_of Π
      ; I = initial_of Π
      ; G = goal_of Π
    in  list_all (is_valid_operator_strips Π) ops 
     (v. I v  None  ListMem v vs) 
     (v. G v  None  ListMem v vs)"

definition is_operator_applicable_in
  :: "'variable strips_state  'variable strips_operator  bool"
  where "is_operator_applicable_in s op  let p = precondition_of op in
    list_all (λv. s v = Some True) p"

(* TODO effect_to_strips and effect_to_assignments could just be removed if we prove a lemma 
  showing the equivalence to effcond semantics.*)
definition effect__strips 
  :: "'variable strips_operator  ('variable, bool) Effect"
  where "effect__strips op 
    = 
      map (λv. (v, True)) (add_effects_of op)
      @ map (λv. (v, False)) (delete_effects_of op)"

definition effect_to_assignments 
  where "effect_to_assignments op  effect__strips op"
(*>*)

text ‹ As discussed in \autoref{sub:serial-sas-plus-and-parallel-strips}, the effect of
a STRIPS operator can be normalized to a conjunction of atomic effects. We can therefore construct 
the successor state by simply converting the list of add effects to assignments to term‹True› resp. 
converting the list of delete effect to a list of assignments to term‹False› and then adding the 
map corresponding to the assignments to the given state terms as shown below in definition 
\ref{isadef:operator-execution-strips}. 
\footnote{Function \path{effect_to_assignments} converts the operator effect to a list of 
assignments. }›

definition  execute_operator
  :: "'variable strips_state 
     'variable strips_operator 
     'variable strips_state" (infixl "" 52)
  where "execute_operator s op
     s ++ map_of (effect_to_assignments op)"

end

Theory STRIPS_Semantics

(*
  Author: Mohammad Abdulaziz, Fred Kurz
*)
theory STRIPS_Semantics
  imports "STRIPS_Representation"
    "List_Supplement"
    "Map_Supplement"
begin
section "STRIPS Semantics"
text ‹ Having provided a concrete implementation of STRIPS and a corresponding locale strips›, we
can now continue to define the semantics of serial and parallel STRIPS plan execution (see
\autoref{sub:serial-sas-plus-and-parallel-strips} and
\autoref{sub:parallel-sas-plus-and-parallel-strips}). ›
subsection "Serial Plan Execution Semantics"

text ‹ Serial plan execution is defined by primitive recursion on the plan.
Definition \autoref{isadef:execute_serial_plan} returns the given state if the state argument does
note satisfy the precondition of the next operator in the plan.
Otherwise it executes the rest of the plan on the successor state term‹execute_operator s op of
the given state and operator. ›

primrec  execute_serial_plan
  where "execute_serial_plan s [] = s"
  | "execute_serial_plan s (op # ops)
    = (if is_operator_applicable_in s op
      then execute_serial_plan (execute_operator s op) ops
      else s
  )"

text ‹ Analogously, a STRIPS trace either returns the singleton list containing only the given
state in case the precondition of the next operator in the plan is not satisfied. Otherwise, the
given state is prepended to trace of the rest of the plan for the successor state of executing the
next operator on the given state. ›

fun  trace_serial_plan_strips
  :: "'variable strips_state  'variable strips_plan  'variable strips_state list"
  where "trace_serial_plan_strips s [] = [s]"
  | "trace_serial_plan_strips s (op # ops)
      = s # (if is_operator_applicable_in s op
        then trace_serial_plan_strips (execute_operator s op) ops
        else [])"

text ‹ Finally, a serial solution is a plan which transforms a given problems initial state into
its goal state and for which all operators are elements of the problem's operator list. ›

definition  is_serial_solution_for_problem
  where "is_serial_solution_for_problem Π π
     (goal_of Π) m execute_serial_plan (initial_of Π) π
       list_all (λop. ListMem op (operators_of Π)) π"

lemma is_valid_problem_strips_initial_of_dom:
  fixes Π:: "'a strips_problem"
  assumes "is_valid_problem_strips Π"
  shows "dom ((Π)I) = set ((Π)𝒱)"
  proof -
    {
      let ?I = "strips_problem.initial_of Π"
      let ?vs = "strips_problem.variables_of Π"
      fix v
      have "?I v  None  ListMem v ?vs"
        using assms(1)
        unfolding is_valid_problem_strips_def
        by meson
      hence "v  dom ?I  v  set ?vs"
        using ListMem_iff
        by fast
    }
    thus ?thesis
      by auto
  qed

lemma is_valid_problem_dom_of_goal_state_is:
  fixes Π:: "'a strips_problem"
  assumes "is_valid_problem_strips Π"
  shows "dom ((Π)G)  set ((Π)𝒱)"
  proof -
    let ?vs = "strips_problem.variables_of Π"
    let ?G = "strips_problem.goal_of Π"
    have nb: "v. ?G v  None  ListMem v ?vs"
      using assms(1)
      unfolding is_valid_problem_strips_def
      by meson
    {
      fix v
      assume "v  dom ?G"
      then have "?G v  None"
        by blast
      hence "v  set ?vs"
        using nb
        unfolding ListMem_iff
        by blast
    }
    thus ?thesis
      by auto
  qed

lemma is_valid_problem_strips_operator_variable_sets:
  fixes Π:: "'a strips_problem"
  assumes "is_valid_problem_strips Π"
    and "op  set ((Π)𝒪)"
  shows "set (precondition_of op)  set ((Π)𝒱)"
    and "set (add_effects_of op)  set ((Π)𝒱)"
    and "set (delete_effects_of op)  set ((Π)𝒱)"
    and "disjnt (set (add_effects_of op)) (set (delete_effects_of op))"
  proof -
    let ?ops = "strips_problem.operators_of Π"
      and ?vs = "strips_problem.variables_of Π"
    have "list_all (is_valid_operator_strips Π) ?ops"
      using assms(1)
      unfolding is_valid_problem_strips_def
      by meson
    moreover have "v  set (precondition_of op). v  set ((Π)𝒱)"
      and "v  set (add_effects_of op). v  set ((Π)𝒱)"
      and "v  set (delete_effects_of op). v  set ((Π)𝒱)"
      and "v  set (add_effects_of op). v  set (delete_effects_of op)"
      and "v  set (delete_effects_of op). v  set (add_effects_of op)"
      using assms(2) calculation
      unfolding is_valid_operator_strips_def list_all_iff Let_def ListMem_iff
      using variables_of_def
      by auto+
    ultimately show "set (precondition_of op)  set ((Π)𝒱)"
      and "set (add_effects_of op)  set ((Π)𝒱)"
      and "set (delete_effects_of op)  set ((Π)𝒱)"
      and "disjnt (set (add_effects_of op)) (set (delete_effects_of op))"
      unfolding disjnt_def
      by fast+
  qed

lemma effect_to_assignments_i:
  assumes "as = effect_to_assignments op"
  shows "as =  (map (λv. (v, True)) (add_effects_of op)
      @ map (λv. (v, False)) (delete_effects_of op))"
  using assms
  unfolding effect_to_assignments_def effect__strips_def
  by auto

lemma effect_to_assignments_ii:
  ― ‹ NOTE effect_to_assignments› can be simplified drastically given that only atomic effects
  and the add-effects as well as delete-effects lists only consist of variables.›
  assumes "as = effect_to_assignments op"
  obtains as1 as2
  where "as = as1 @ as2"
    and "as1 = map (λv. (v, True)) (add_effects_of op)"
    and "as2 = map (λv. (v, False)) (delete_effects_of op)"
  by (simp add: assms effect__strips_def effect_to_assignments_def)

― ‹ NOTE Show that for every variable v› in either the add effect list or the delete effect
list, there exists an assignment in  \isaname{effect_to_assignments op} representing setting v› to
true respectively setting v› to false. Note that the first assumption amounts to saying that
the add effect list is not empty. This also requires us to split lemma
\isaname{effect_to_assignments_iii} into two separate lemmas since add and delete effect lists are
not required to both contain at least one variable simultaneously. ›
lemma effect_to_assignments_iii_a:
  fixes v
  assumes "v  set (add_effects_of op)"
    and "as = effect_to_assignments op"
  obtains a where "a  set as" "a = (v, True)"
  proof -
    let ?add_assignments = "(λv. (v, True)) ` set (add_effects_of op)"
    let ?delete_assignments = "(λv. (v, False)) ` set (delete_effects_of op)"
    obtain as1 as2
      where a1: "as = as1 @ as2"
        and a2: "as1 = map (λv. (v, True)) (add_effects_of op)"
        and a3: "as2 = map (λv. (v, False)) (delete_effects_of op)"
      using assms(2) effect_to_assignments_ii
      by blast
    then have b: "set as
      = ?add_assignments  ?delete_assignments"
      by auto
    ― ‹ NOTE The existence of an assignment as proposed can be shown by the following sequence of
      set inclusions. ›
    {
      from b have "?add_assignments  set as"
        by blast
      moreover have "{(v, True)}  ?add_assignments"
        using assms(1) a2
        by blast
      ultimately have "a. a  set as  a = (v, True)"
        by blast
    }
    then show ?thesis
      using that
      by blast
  qed

lemma effect_to_assignments_iii_b:
  ― ‹ NOTE This proof is symmetrical to the one above. ›
  fixes v
  assumes "v  set (delete_effects_of op)"
    and "as = effect_to_assignments op"
  obtains a where "a  set as" "a = (v, False)"
  proof -
    let ?add_assignments = "(λv. (v, True)) ` set (add_effects_of op)"
    let ?delete_assignments = "(λv. (v, False)) ` set (delete_effects_of op)"
    obtain as1 as2
      where a1: "as = as1 @ as2"
        and a2: "as1 = map (λv. (v, True)) (add_effects_of op)"
        and a3: "as2 = map (λv. (v, False)) (delete_effects_of op)"
      using assms(2) effect_to_assignments_ii
      by blast
    then have b: "set as
      = ?add_assignments  ?delete_assignments"
      by auto
    ― ‹ NOTE The existence of an assignment as proposed can be shown by the following sequence of
      set inclusions. ›
    {
      from b have "?delete_assignments  set as"
        by blast
      moreover have "{(v, False)}  ?delete_assignments"
        using assms(1) a2
        by blast
      ultimately have "a. a  set as  a = (v, False)"
        by blast
    }
    then show ?thesis
      using that
      by blast
  qed

lemma effect__strips_i:
  fixes op
  assumes "e = effect__strips op"
  obtains es1 es2
    where "e = (es1 @ es2)"
      and "es1 = map (λv. (v, True)) (add_effects_of op)"
      and "es2 = map (λv. (v, False)) (delete_effects_of op)"
  proof -
    obtain es1 es2 where a: "e = (es1 @ es2)"
      and b: "es1 = map (λv. (v, True)) (add_effects_of op)"
      and c: "es2 = map (λv. (v, False)) (delete_effects_of op)"
      using assms(1)
      unfolding effect__strips_def
      by blast
    then show ?thesis
      using that
      by force
  qed

lemma effect__strips_ii:
  fixes op
  assumes "e = ConjunctiveEffect (es1 @ es2)"
    and "es1 = map (λv. (v, True)) (add_effects_of op)"
    and "es2 = map (λv. (v, False)) (delete_effects_of op)"
  shows "v  set (add_effects_of op). (e'  set es1. e' = (v, True))"
    and "v  set (delete_effects_of op). (e'  set es2. e' = (v, False))"
  proof
  ― ‹ NOTE Show that for each variable v› in the add effect list, we can obtain an atomic effect
  with true value. ›
    fix v
    {
      assume a: "v  set (add_effects_of op)"
      have "set es1 = (λv. (v, True)) ` set (add_effects_of op)"
        using assms(2) List.set_map
        by auto
      then obtain e'
        where "e'  set es1"
        and "e' =  (λv. (v, True)) v"
        using a
        by blast
      then have "e'  set es1. e' = (v, True)"
        by blast
    }
    thus "v  set (add_effects_of op)  e'  set es1. e' = (v, True)"
      by fast
  ― ‹ NOTE the proof is symmetrical to the one above: for each variable v in the delete effect list,
  we can obtain an atomic effect with v being false. ›
  next
    {
      fix v
      assume a: "v  set (delete_effects_of op)"
      have "set es2 = (λv. (v, False)) ` set (delete_effects_of op)"
        using assms(3) List.set_map
        by force
      then obtain e''
        where "e''  set es2"
        and "e'' =  (λv. (v, False)) v"
        using a
        by blast
      then have "e''  set es2. e'' = (v, False)"
        by blast
    }
    thus "vset (delete_effects_of op). e'set es2. e' = (v, False)"
      by fast
  qed

(* TODO refactor theory Appendix AND make visible? *)
lemma map_of_constant_assignments_dom:
  ― ‹ NOTE ancillary lemma used in the proof below. ›
  assumes "m = map_of (map (λv. (v, d)) vs)"
  shows "dom m = set vs"
  proof -
    let ?vs' = "map (λv. (v, d)) vs"
    have "dom m = fst ` set ?vs'"
      using assms(1) dom_map_of_conv_image_fst
      by metis
    moreover have "fst ` set ?vs' = set vs"
      by force
    ultimately show ?thesis
      by argo
  qed

lemma effect__strips_iii_a:
  assumes "s' = (s  op)"
  shows "v. v  set (add_effects_of op)  s' v = Some True"
  proof -
    fix v
    assume a: "v  set (add_effects_of op)"
    let ?as = "effect_to_assignments op"
    obtain as1 as2 where b: "?as = as1 @ as2"
      and c: "as1 = map (λv. (v, True)) (add_effects_of op)"
      and "as2 = map (λv. (v, False)) (delete_effects_of op)"
      using effect_to_assignments_ii
      by blast
    have d: "map_of ?as = map_of as2 ++ map_of as1"
      using b Map.map_of_append
      by auto
    {
      ― ‹ TODO refactor? ›
      let ?vs = "add_effects_of op"
      have "?vs  []"
        using a
        by force
      then have "dom (map_of as1) = set (add_effects_of op)"
        using c map_of_constant_assignments_dom
        by metis
      then have "v  dom (map_of as1)"
        using a
        by blast
      then have "map_of ?as v = map_of as1 v"
        using d
        by force
    } moreover {
      let ?f = "λ_. True"
      from c have "map_of as1 = (Some  ?f) |` (set (add_effects_of op))"
        using map_of_map_restrict
        by fast
      then have "map_of as1 v = Some True"
        using a
        by auto
    }
    moreover have "s' = s ++ map_of as2 ++ map_of as1"
      using assms(1)
      unfolding execute_operator_def
      using b
      by simp
    ultimately show "s' v = Some True"
      by simp
  qed

(* TODO In contrast to the proof above we need proof preparation with auto. Why? *)
lemma effect__strips_iii_b:
  assumes "s' = (s  op)"
  shows "v. v  set (delete_effects_of op)  v  set (add_effects_of op)  s' v = Some False"
  proof (auto)
    fix v
    assume a1: "v  set (add_effects_of op)" and a2: "v  set (delete_effects_of op)"
    let ?as = "effect_to_assignments op"
    obtain as1 as2 where b: "?as = as1 @ as2"
      and c: "as1 = map (λv. (v, True)) (add_effects_of op)"
      and d: "as2 = map (λv. (v, False)) (delete_effects_of op)"
      using effect_to_assignments_ii
      by blast
    have e: "map_of ?as = map_of as2 ++ map_of as1"
      using b Map.map_of_append
      by auto
    {
      have "dom (map_of as1) = set (add_effects_of op)"
        using c map_of_constant_assignments_dom
        by metis
      then have "v  dom (map_of as1)"
        using a1
        by blast
    } note f = this
    {
      let ?vs = "delete_effects_of op"
      have "?vs  []"
        using a2
        by force
      then have "dom (map_of as2) = set ?vs"
        using d  map_of_constant_assignments_dom
        by metis
    } note g = this
    {
      have "s' = s ++ map_of as2 ++ map_of as1"
        using assms(1)
        unfolding execute_operator_def
        using b
        by simp
      thm  f map_add_dom_app_simps(3)[OF f, of "s ++ map_of as2"]
      moreover have "s' v = (s ++ map_of as2) v"
        using calculation  map_add_dom_app_simps(3)[OF f, of "s ++ map_of as2"]
        by blast
      moreover have "v  dom (map_of as2)"
        using a2 g
        by argo
      ultimately have "s' v = map_of as2 v"
        by fastforce
    }
    moreover
    {
      let ?f = "λ_. False"
      from d have "map_of as2 = (Some  ?f) |` (set (delete_effects_of op))"
        using map_of_map_restrict
        by fast
      then have "map_of as2 v = Some False"
        using a2
        by force
    }
    ultimately show  " s' v = Some False"
      by argo
  qed

(* TODO We need proof preparation with auto. Why? *)
lemma effect__strips_iii_c:
  assumes "s' = (s  op)"
  shows "v. v  set (add_effects_of op)  v  set (delete_effects_of op)  s' v = s v"
  proof (auto)
    fix v
    assume a1: "v  set (add_effects_of op)" and a2: "v  set (delete_effects_of op)"
    let ?as = "effect_to_assignments op"
    obtain as1 as2 where b: "?as = as1 @ as2"
      and c: "as1 = map (λv. (v, True)) (add_effects_of op)"
      and d: "as2 = map (λv. (v, False)) (delete_effects_of op)"
      using effect_to_assignments_ii
      by blast
    have e: "map_of ?as = map_of as2 ++ map_of as1"
      using b Map.map_of_append
      by auto
    {
      have "dom (map_of as1) = set (add_effects_of op)"
        using c map_of_constant_assignments_dom
        by metis
      then have "v  dom (map_of as1)"
        using a1
        by blast
    } moreover  {
      have "dom (map_of as2) = set (delete_effects_of op)"
        using d map_of_constant_assignments_dom
        by metis
      then have "v  dom (map_of as2)"
        using a2
        by blast
    }
    ultimately show "s' v = s v"
      using assms(1)
      unfolding execute_operator_def
      by (simp add: b map_add_dom_app_simps(3))
  qed

text ‹The following theorem combines three preceding sublemmas which show
that the following properties hold for the successor state s' ≡ execute_operator op s›
obtained by executing an operator op› in a state s›:
\footnote{Lemmas \path{effect__strips_iii_a}, \path{effect__strips_iii_b}, and
\path{effect__strips_iii_c} (not shown).}

\begin{itemize}
  \item every add effect is satisfied in s'› (sublemma  \isaname{effect__strips_iii_a}); and,
  \item every delete effect that is not also an add effect is not satisfied in s'› (sublemma
\isaname{effect__strips_iii_b}); and finally
  \item the state remains unchanged---i.e. s' v = s v›---for all variables which are neither an
add effect nor a delete effect.
\end{itemize} ›

(* TODO? Rewrite theorem ‹operator_effect__strips› to match ‹s ++ map_of (
effect_to_assignments op)› rather than ‹execute_operator Π op s› since we need this
form later on for the parallel execution theorem? *)
theorem  operator_effect__strips:
  assumes "s' = (s  op)"
  shows
    "v.
      v  set (add_effects_of op)
       s' v = Some True"
    and "v.
      v  set (add_effects_of op)  v  set (delete_effects_of op)
       s' v = Some False"
    and "v.
      v  set (add_effects_of op)  v  set (delete_effects_of op)
       s' v = s v"
proof (auto)
  show "v.
    v  set (add_effects_of op)
     s' v = Some True"
    using assms effect__strips_iii_a
    by fast
next
  show "v.
    v  set (add_effects_of op)
     v  set (delete_effects_of op)
      s' v = Some False"
    using assms effect__strips_iii_b
    by fast
next
  show "v.
    v  set (add_effects_of op)
     v  set (delete_effects_of op)
     s' v = s v"
    using assms effect__strips_iii_c
    by metis
qed

subsection "Parallel Plan Semantics"

definition "are_all_operators_applicable s ops
   list_all (λop. is_operator_applicable_in s op) ops"

definition "are_operator_effects_consistent op1 op2  let
    add1 = add_effects_of op1
    ; add2 = add_effects_of op2
    ; del1 = delete_effects_of op1
    ; del2 = delete_effects_of op2
  in ¬list_ex (λv. list_ex ((=) v) del2) add1  ¬list_ex (λv. list_ex ((=) v) add2) del1"

definition "are_all_operator_effects_consistent ops 
  list_all (λop. list_all (are_operator_effects_consistent op) ops) ops"

definition execute_parallel_operator
  :: "'variable strips_state
     'variable strips_operator list
     'variable strips_state"
  where "execute_parallel_operator s ops
     foldl (++) s (map (map_of  effect_to_assignments) ops)"
text ‹ The parallel STRIPS execution semantics is defined in similar way as the serial STRIPS
execution semantics. However, the applicability test is lifted to parallel operators and we
additionally test for operator consistency (which was unecessary in the serial case). ›

fun  execute_parallel_plan
  :: "'variable strips_state
     'variable strips_parallel_plan
     'variable strips_state"
  where "execute_parallel_plan s [] = s"
  | "execute_parallel_plan s (ops # opss) = (if
      are_all_operators_applicable s ops
       are_all_operator_effects_consistent ops
    then execute_parallel_plan (execute_parallel_operator s ops) opss
    else s)"

definition "are_operators_interfering op1 op2
   list_ex (λv. list_ex ((=) v) (delete_effects_of op1)) (precondition_of op2)
      list_ex (λv. list_ex ((=) v) (precondition_of op1)) (delete_effects_of op2)"

(* TODO rewrite as inductive predicate *)
primrec are_all_operators_non_interfering
  :: "'variable strips_operator list  bool"
  where "are_all_operators_non_interfering [] = True"
  | "are_all_operators_non_interfering (op # ops)
    = (list_all (λop'. ¬are_operators_interfering op op') ops
       are_all_operators_non_interfering ops)"

text ‹ Since traces mirror the execution semantics, the same is true for the definition of
parallel STRIPS plan traces. ›

fun  trace_parallel_plan_strips
  :: "'variable strips_state  'variable strips_parallel_plan  'variable strips_state list"
  where "trace_parallel_plan_strips s [] = [s]"
  | "trace_parallel_plan_strips s (ops # opss) = s # (if
      are_all_operators_applicable s ops
       are_all_operator_effects_consistent ops
    then trace_parallel_plan_strips (execute_parallel_operator s ops) opss
    else [])"

text ‹ Similarly, the definition of parallel solutions requires that the parallel execution
semantics transforms the initial problem into the goal state of the problem and that every
operator of every parallel operator in the parallel plan is an operator that is defined in the
problem description. ›

definition  is_parallel_solution_for_problem
  where "is_parallel_solution_for_problem Π π
     (strips_problem.goal_of Π) m execute_parallel_plan
        (strips_problem.initial_of Π) π
       list_all (λops. list_all (λop.
        ListMem op (strips_problem.operators_of Π)) ops) π"


(* TODO rename are_all_operators_applicable_in_set *)
lemma are_all_operators_applicable_set:
  "are_all_operators_applicable s ops
     (op  set ops. v  set (precondition_of op). s v = Some True)"
  unfolding are_all_operators_applicable_def
    STRIPS_Representation.is_operator_applicable_in_def list_all_iff
  by presburger

(* TODO rename are_all_operators_applicable_in_cons *)
lemma are_all_operators_applicable_cons:
  assumes "are_all_operators_applicable s (op # ops)"
  shows "is_operator_applicable_in s op"
    and "are_all_operators_applicable s ops"
  proof -
    from assms have a: "list_all (λop. is_operator_applicable_in s op) (op # ops)"
      unfolding are_all_operators_applicable_def is_operator_applicable_in_def
        STRIPS_Representation.is_operator_applicable_in_def
      by blast
    then have "is_operator_applicable_in s op"
      by fastforce
    moreover {
      from a have "list_all (λop. is_operator_applicable_in s op) ops"
        by simp
      then have "are_all_operators_applicable s ops"
      using are_all_operators_applicable_def is_operator_applicable_in_def
        STRIPS_Representation.is_operator_applicable_in_def
        by blast
      }
    ultimately show "is_operator_applicable_in s op"
      and "are_all_operators_applicable s ops"
       by fast+
  qed

lemma are_operator_effects_consistent_set:
  assumes "op1  set ops"
    and "op2  set ops"
  shows "are_operator_effects_consistent op1 op2
     = (set (add_effects_of op1)  set (delete_effects_of op2) = {}
       set (delete_effects_of op1)  set (add_effects_of op2) = {})"
  proof -
    have "(¬list_ex (λv. list_ex ((=) v) (delete_effects_of op2)) (add_effects_of op1))
      = (set (add_effects_of op1)  set (delete_effects_of op2) = {})"
      using list_ex_intersection[of "delete_effects_of op2" "add_effects_of op1"]
      by meson
    moreover have "(¬list_ex (λv. list_ex ((=) v) (add_effects_of op2)) (delete_effects_of op1))
      = (set (delete_effects_of op1)  set (add_effects_of op2) = {})"
      using list_ex_intersection[of "add_effects_of op2"  "delete_effects_of op1"]
      by meson
    ultimately show "are_operator_effects_consistent op1 op2
       = (set (add_effects_of op1)  set (delete_effects_of op2) = {}
         set (delete_effects_of op1)  set (add_effects_of op2) = {})"
      unfolding are_operator_effects_consistent_def
      by presburger
  qed

lemma are_all_operator_effects_consistent_set:
  "are_all_operator_effects_consistent ops
     (op1  set ops. op2  set ops.
      (set (add_effects_of op1)  set (delete_effects_of op2) = {})
         (set (delete_effects_of op1)  set (add_effects_of op2) = {}))"
  proof -
    {
      fix op1 op2
      assume "op1  set ops" and "op2  set ops"
      hence "are_operator_effects_consistent op1 op2
        = (set (add_effects_of op1)  set (delete_effects_of op2) = {}
           set (delete_effects_of op1)  set (add_effects_of op2) = {})"
        using are_operator_effects_consistent_set[of op1 ops op2]
        by fast
    }
    thus ?thesis
      unfolding are_all_operator_effects_consistent_def list_all_iff
      by force
  qed

lemma are_all_effects_consistent_tail:
  assumes "are_all_operator_effects_consistent (op # ops)"
  shows "are_all_operator_effects_consistent ops"
  proof -
    from assms
    have a: "list_all (λop'. list_all (are_operator_effects_consistent op')
      (Cons op ops)) (Cons op ops)"
      unfolding are_all_operator_effects_consistent_def
      by blast
    then have b_1: "list_all (are_operator_effects_consistent op) (op # ops)"
      and b_2: "list_all (λop'. list_all (are_operator_effects_consistent op') (op # ops)) ops"
      by force+
    then have "list_all (are_operator_effects_consistent op) ops"
      by simp
    moreover
    {
      {
        fix z
        assume "z  set (Cons op ops)"
         and "list_all (are_operator_effects_consistent z) (op # ops)"
        then have "list_all (are_operator_effects_consistent z) ops"
          by auto
      }
      then have "list_all (λop'. list_all (are_operator_effects_consistent op') ops) ops"
        using list.pred_mono_strong[of
            "(λop'. list_all (are_operator_effects_consistent op') (op # ops))"
            "Cons op ops" "(λop'. list_all (are_operator_effects_consistent op')  ops)"
          ] a
        by fastforce
    }
    ultimately have "list_all (are_operator_effects_consistent op) ops
       list_all (λop'. list_all (are_operator_effects_consistent op') ops) ops"
      by blast
    then show ?thesis
      using are_all_operator_effects_consistent_def
      by fast
  qed

lemma are_all_operators_non_interfering_tail:
  assumes "are_all_operators_non_interfering (op # ops)"
  shows "are_all_operators_non_interfering ops"
  using assms
  unfolding are_all_operators_non_interfering_def
  by simp

lemma are_operators_interfering_symmetric:
  assumes "are_operators_interfering op1 op2"
  shows "are_operators_interfering op2 op1"
  using assms
  unfolding are_operators_interfering_def list_ex_iff
  by fast

― ‹ A small technical characterizing operator lists with property
\isaname{are_all_operators_non_interfering ops}. We show that pairs of distinct operators which interfere
with one another cannot both be contained in the corresponding operator set. ›
lemma are_all_operators_non_interfering_set_contains_no_distinct_interfering_operator_pairs:
  assumes "are_all_operators_non_interfering ops"
    and "are_operators_interfering op1 op2"
    and "op1  op2"
  shows "op1  set ops  op2  set ops"
  using assms
  proof (induction ops)
    case (Cons op ops)
    thm Cons.IH[OF _ Cons.prems(2, 3)]
    have nb1: "op'  set ops. ¬are_operators_interfering op op'"
      and nb2: "are_all_operators_non_interfering ops"
      using Cons.prems(1)
      unfolding are_all_operators_non_interfering.simps(2) list_all_iff
      by blast+
    then consider (A) "op = op1"
      | (B) "op = op2"
      | (C) "op  op1  op  op2"
      by blast
    thus ?case
      proof (cases)
        case A
        {
          assume "op2  set (op # ops)"
          then have "op2  set ops"
            using Cons.prems(3) A
            by force
          then have "¬are_operators_interfering op1 op2"
            using nb1 A
            by fastforce
          hence False
            using Cons.prems(2)..
        }
        thus ?thesis
          by blast
      next
        case B
        {
          assume "op1  set (op # ops)"
          then have "op1  set ops"
            using Cons.prems(3) B
            by force
          then have "¬are_operators_interfering op1 op2"
            using nb1 B are_operators_interfering_symmetric
            by blast
          hence False
            using Cons.prems(2)..
        }
        thus ?thesis
          by blast
      next
        case C
        thus ?thesis
          using Cons.IH[OF nb2 Cons.prems(2, 3)]
          by force
      qed
  qed simp

(* TODO The recurring ‹list_all ↝ ∀› transformations could be refactored into a general
lemma.
   TODO refactor (also used in lemma ‹execute_serial_plan_split_i›). *)
lemma execute_parallel_plan_precondition_cons_i:
  fixes s :: "('variable, bool) state"
  assumes "¬are_operators_interfering op op'"
    and "is_operator_applicable_in s op"
    and "is_operator_applicable_in s op'"
  shows "is_operator_applicable_in (s ++ map_of (effect_to_assignments op)) op'"
  proof -
    let ?s' = "s ++ map_of (effect_to_assignments op)"
    ― ‹ TODO slightly hackish to exploit the definition of execute_operator›, but we
  otherwise have to rewrite theorem operator_effect__strips› (which is a todo as of now). ›
    {
      have a: "?s' = s  op"
        by (simp add: execute_operator_def)
      then have "v. v  set (add_effects_of op)  ?s' v = Some True"
        and "v. v  set (add_effects_of op)  v  set (delete_effects_of op)  ?s' v = Some False"
        and "v. v  set (add_effects_of op)  v  set (delete_effects_of op)  ?s' v = s v"
        using operator_effect__strips
        by metis+
    }
    note a = this
    ― ‹ TODO refactor lemma not_have_interference_set›. ›
    {
      fix v
      assume α: "v  set (precondition_of op')"
      {
        fix v
        have "¬list_ex ((=) v) (delete_effects_of op)
          = list_all (λv'. ¬v = v') (delete_effects_of op)"
          using not_list_ex_equals_list_all_not[
              where P="(=) v" and xs="delete_effects_of op"]
          by blast
      } moreover {
        from assms(1)
        have "¬list_ex (λv. list_ex ((=) v) (delete_effects_of op)) (precondition_of op')"
          unfolding are_operators_interfering_def
          by blast
        then have "list_all (λv. ¬list_ex ((=) v) (delete_effects_of op)) (precondition_of op')"
          using not_list_ex_equals_list_all_not[
              where P="λv. list_ex ((=) v) (delete_effects_of op)" and xs="precondition_of op'"]
          by blast
      }
      ultimately have β:
        "list_all (λv. list_all (λv'. ¬v = v') (delete_effects_of op)) (precondition_of op')"
        by presburger
      moreover {
        fix v
        have "list_all (λv'. ¬v = v') (delete_effects_of op)
          = (v'  set (delete_effects_of op). ¬v = v')"
          using list_all_iff [where P="λv'. ¬v = v'" and x="delete_effects_of op"]
          .
      }
      ultimately have "v  set (precondition_of op'). v'  set (delete_effects_of op). ¬v = v'"
        using β list_all_iff[
          where P="λv. list_all (λv'. ¬v = v') (delete_effects_of op)"
            and x="precondition_of op'"]
        by presburger
      then have "v  set (delete_effects_of op)"
        using α
        by fast
    }
    note b = this
    {
      fix v
      assume a: "v  set (precondition_of op')"
      have "list_all (λv. s v = Some True) (precondition_of op')"
        using assms(3)
        unfolding is_operator_applicable_in_def
          STRIPS_Representation.is_operator_applicable_in_def
        by presburger
      then have "v  set (precondition_of op'). s v = Some True"
        using list_all_iff[where P="λv. s v = Some True" and x="precondition_of op'"]
        by blast
      then have "s v = Some True"
        using a
        by blast
    }
    note c = this
    {
      fix v
      assume d: "v  set (precondition_of op')"
      then have "?s' v = Some True"
      proof (cases "v  set (add_effects_of op)")
        case True
        then show ?thesis
          using a
          by blast
      next
        case e: False
        then show ?thesis
        proof (cases "v  set (delete_effects_of op)")
          case True
          then show ?thesis
            using assms(1) b d
              by fast
          next
            case False
            then have "?s' v = s v"
              using a e
              by blast
            then show ?thesis
              using c d
              by presburger
          qed
      qed
    }
    then have "list_all (λv. ?s' v = Some True) (precondition_of op')"
      using list_all_iff[where P="λv. ?s' v = Some True" and x="precondition_of op'"]
      by blast
    then show ?thesis
      unfolding is_operator_applicable_in_def
        STRIPS_Representation.is_operator_applicable_in_def
      by auto
  qed

― ‹ The third assumption are_all_operators_non_interfering (a # ops)›" is not part of the
precondition of \isaname{execute_parallel_operator} but is required for the proof of the
subgoal hat applicable is maintained. ›
lemma execute_parallel_plan_precondition_cons:
  fixes a :: "'variable strips_operator"
  assumes "are_all_operators_applicable s (a # ops)"
    and "are_all_operator_effects_consistent (a # ops)"
    and "are_all_operators_non_interfering (a # ops)"
  shows "are_all_operators_applicable (s ++ map_of (effect_to_assignments a)) ops"
    and "are_all_operator_effects_consistent ops"
    and "are_all_operators_non_interfering ops"
  using are_all_effects_consistent_tail[OF assms(2)]
    are_all_operators_non_interfering_tail[OF assms(3)]
  proof -
    let ?s' = "s ++ map_of (effect_to_assignments a)"
    have nb1: "op  set (a # ops). is_operator_applicable_in s op"
      using assms(1) are_all_operators_applicable_set
      unfolding are_all_operators_applicable_def is_operator_applicable_in_def
        STRIPS_Representation.is_operator_applicable_in_def list_all_iff
      by blast
    have nb2: "op  set ops. ¬are_operators_interfering a op"
      using assms(3)
      unfolding are_all_operators_non_interfering_def list_all_iff
      by simp
    have nb3: "is_operator_applicable_in s a"
      using assms(1) are_all_operators_applicable_set
      unfolding are_all_operators_applicable_def is_operator_applicable_in_def
        STRIPS_Representation.is_operator_applicable_in_def list_all_iff
      by force
    {
      fix op
      assume op_in_ops: "op  set ops"
      hence "is_operator_applicable_in ?s' op"
        using execute_parallel_plan_precondition_cons_i[of a op] nb1 nb2 nb3
        by force
    }
    then show "are_all_operators_applicable ?s' ops"
      unfolding are_all_operators_applicable_def list_all_iff
        is_operator_applicable_in_def
      by blast
  qed

lemma execute_parallel_operator_cons[simp]:
  "execute_parallel_operator s (op # ops)
    = execute_parallel_operator (s ++ map_of (effect_to_assignments op)) ops"
  unfolding execute_parallel_operator_def
  by simp

lemma execute_parallel_operator_cons_equals:
  assumes "are_all_operators_applicable s (a # ops)"
    and "are_all_operator_effects_consistent (a # ops)"
    and "are_all_operators_non_interfering (a # ops)"
  shows "execute_parallel_operator s (a # ops)
    = execute_parallel_operator (s ++ map_of (effect_to_assignments a)) ops"
  proof -
    let ?s' = "s ++ map_of (effect_to_assignments a)"
    {
      from assms(1, 2)
      have "execute_parallel_operator s (Cons a ops)
        = foldl (++) s (map (map_of  effect_to_assignments) (Cons a ops))"
         unfolding execute_parallel_operator_def
         by presburger
       also have " = foldl (++) (?s')
         (map (map_of  effect_to_assignments) ops)"
         by auto
       finally have "execute_parallel_operator s (Cons a ops)
         = foldl (++) (?s')
          (map (map_of  effect_to_assignments) ops)"
         using execute_parallel_operator_def
         by blast
     }
    ― ‹ NOTE the precondition of \isaname{execute_parallel} for a # ops› is also true for the tail
    list and state ?s'› as shown in lemma
    \isaname{execute_parallel_operator_precondition_cons}. Hence the precondition for the r.h.s.
    of the goal also holds. ›
     moreover have "execute_parallel_operator ?s' ops
        = foldl (++) (s ++ (map_of  effect_to_assignments) a)
          (map (map_of  effect_to_assignments) ops)"
         by (simp add: execute_parallel_operator_def)
    ultimately show ?thesis
      by force
  qed

― ‹ We show here that following the lemma above, executing one operator of a parallel
operator can be replaced by a (single) STRIPS operator execution. ›
corollary execute_parallel_operator_cons_equals_corollary:
  assumes "are_all_operators_applicable s (a # ops)"
  shows "execute_parallel_operator s (a # ops)
    = execute_parallel_operator (s  a) ops"
  proof -
    let ?s' = "s ++ map_of (effect_to_assignments a)"
    from assms
    have "execute_parallel_operator s (a # ops)
      = execute_parallel_operator (s ++ map_of (effect_to_assignments a)) ops"
      using execute_parallel_operator_cons_equals
      by simp
    moreover have "?s' = s  a"
      unfolding execute_operator_def
      by simp
    ultimately show ?thesis
      by argo
  qed

(* TODO duplicate? *)
lemma effect_to_assignments_simp[simp]: "effect_to_assignments op
  = map (λv. (v, True)) (add_effects_of op) @ map (λv. (v, False)) (delete_effects_of op)"
  by (simp add: effect_to_assignments_i)

lemma effect_to_assignments_set_is[simp]:
  "set (effect_to_assignments op) = { ((v, a), True) | v a. (v, a)  set (add_effects_of op) }
     { ((v, a), False) | v a. (v, a)  set (delete_effects_of op) }"
proof -
    obtain as where "effect__strips op = as"
      and "as = map (λv. (v, True)) (add_effects_of op)
        @ map (λv. (v, False)) (delete_effects_of op)"
      unfolding effect__strips_def
      by blast
    moreover have "as
      = map (λv. (v, True)) (add_effects_of op) @ map (λv. (v, False)) (delete_effects_of op)"
      using calculation(2)
      unfolding map_append map_map comp_apply
      by auto
    moreover have "effect_to_assignments op = as"
      unfolding effect_to_assignments_def calculation(1, 2)
      by auto
    ultimately show ?thesis
      unfolding set_map
      by auto
  qed

corollary effect_to_assignments_construction_from_function_graph:
  assumes "set (add_effects_of op)  set (delete_effects_of op) = {}"
  shows "effect_to_assignments op = map
    (λv. (v, if ListMem v (add_effects_of op) then True else False))
    (add_effects_of op @ delete_effects_of op)"
    and "effect_to_assignments op = map
    (λv. (v, if ListMem v (delete_effects_of op) then False else True))
    (add_effects_of op @ delete_effects_of op)"
  proof -
    let ?f = "λv. (v, if ListMem v (add_effects_of op) then True else False)"
      and ?g = "λv. (v, if ListMem v (delete_effects_of op) then False else True)"
    {
      have "map ?f (add_effects_of op @ delete_effects_of op)
        = map ?f (add_effects_of op) @ map ?f (delete_effects_of op)"
        using map_append
        by fast
      ― ‹ TODO slow. ›
      hence "effect_to_assignments op = map ?f (add_effects_of op @ delete_effects_of op)"
        using ListMem_iff assms
        by fastforce
    } moreover {
      have "map ?g (add_effects_of op @ delete_effects_of op)
        = map ?g (add_effects_of op) @ map ?g (delete_effects_of op)"
        using map_append
        by fast
      ― ‹ TODO slow. ›
      hence "effect_to_assignments op = map ?g (add_effects_of op @ delete_effects_of op)"
        using ListMem_iff assms
        by fastforce
    }
    ultimately show "effect_to_assignments op = map
      (λv. (v, if ListMem v (add_effects_of op) then True else False))
      (add_effects_of op @ delete_effects_of op)"
      and "effect_to_assignments op = map
      (λv. (v, if ListMem v (delete_effects_of op) then False else True))
      (add_effects_of op @ delete_effects_of op)"
      by blast+
  qed

corollary map_of_effect_to_assignments_is_none_if:
  assumes "¬v  set (add_effects_of op)"
    and "¬v  set (delete_effects_of op)"
  shows "map_of (effect_to_assignments op) v = None"
  proof -
    let ?l = "effect_to_assignments op"
    {
      have "set ?l = { (v, True) | v. v  set (add_effects_of op) }
         { (v, False) | v. v  set (delete_effects_of op)}"
        by auto
      then have "fst ` set ?l
        = (fst ` {(v, True) | v. v  set (add_effects_of op)})
           (fst ` {(v, False) | v. v  set (delete_effects_of op)})"
        using image_Un[of fst "{(v, True) | v. v  set (add_effects_of op)}"
           "{(v, False) | v. v  set (delete_effects_of op)}"]
        by presburger
      ― ‹ TODO slow.›
      also have " = (fst ` (λv. (v, True)) ` set (add_effects_of op))
         (fst ` (λv. (v, False)) ` set (delete_effects_of op))"
        using setcompr_eq_image[of "λv. (v, True)" "λv. v  set (add_effects_of op)"]
          setcompr_eq_image[of "λv. (v, False)" "λv. v  set (delete_effects_of op)"]
        by simp
      ― ‹ TODO slow.›
      also have " = id ` set (add_effects_of op)  id ` set (delete_effects_of op)"
        by force
      ― ‹ TODO slow.›
      finally have "fst ` set ?l = set (add_effects_of op)  set (delete_effects_of op)"
        by auto
      hence "v  fst ` set ?l"
        using assms(1, 2)
        by blast
    }
    thus ?thesis
      using map_of_eq_None_iff[of ?l v]
      by blast
  qed

lemma execute_parallel_operator_positive_effect_if_i:
  assumes "are_all_operators_applicable s ops"
    and "are_all_operator_effects_consistent ops"
    and "op  set ops"
    and "v  set (add_effects_of op)"
  shows "map_of (effect_to_assignments op) v = Some True"
  proof -
    let ?f = "λx. if ListMem x (add_effects_of op) then True else False"
      and ?l'= " map (λv. (v, if ListMem v (add_effects_of op) then True else False))
        (add_effects_of op @ delete_effects_of op)"
    have "set (add_effects_of op)  {}"
      using assms(4)
      by fastforce
    moreover {
      have "set (add_effects_of op)  set (delete_effects_of op) = {}"
        using are_all_operator_effects_consistent_set assms(2, 3)
        by fast
      moreover have "effect_to_assignments op = ?l'"
        using effect_to_assignments_construction_from_function_graph(1) calculation
        by fast
      ultimately have "map_of (effect_to_assignments op) = map_of ?l'"
        by argo
    }
    ultimately have "map_of (effect_to_assignments op) v = Some (?f v)"
      using Map_Supplement.map_of_from_function_graph_is_some_if[
          of _ _ "?f", OF _ assms(4)]
      by simp
    thus ?thesis
      using ListMem_iff assms(4)
      by metis
  qed

lemma execute_parallel_operator_positive_effect_if:
  fixes ops
  assumes "are_all_operators_applicable s ops"
    and "are_all_operator_effects_consistent ops"
    and "op  set ops"
    and "v  set (add_effects_of op)"
  shows "execute_parallel_operator s ops v = Some True"
  proof -
    let ?l = "map (map_of  effect_to_assignments) ops"
    have set_l_is: "set ?l = (map_of  effect_to_assignments) ` set ops"
      using set_map
      by fastforce
    {
      let ?m = "(map_of  effect_to_assignments) op"
      have "?m  set ?l"
        using assms(3) set_l_is
        by blast
      moreover have "?m v = Some True"
        using execute_parallel_operator_positive_effect_if_i[OF assms]
        by fastforce
      ultimately have "m  set ?l. m v = Some True"
        by blast
    }
    moreover {
      fix m'
      assume "m'  set ?l"
      then obtain op'
        where op'_in_set_ops: "op'  set ops"
          and m'_is: "m' = (map_of  effect_to_assignments) op'"
        by auto
      then have "set (add_effects_of op)  set (delete_effects_of op') = {}"
        using assms(2, 3) are_all_operator_effects_consistent_set[of ops]
        by blast
      then have "v  set (delete_effects_of op')"
        using assms(4)
        by blast
      then consider (v_in_set_add_effects) "v  set (add_effects_of op')"
        | (otherwise) "¬v  set (add_effects_of op')  ¬v  set (delete_effects_of op')"
        by blast
      hence "m' v = Some True  m' v = None"
        proof (cases)
          case v_in_set_add_effects
          ― ‹ TODO slow. ›
          thus ?thesis
            using execute_parallel_operator_positive_effect_if_i[
                OF assms(1, 2) op'_in_set_ops, of v] m'_is
            by simp
        next
          case otherwise
          then have "¬v  set (add_effects_of op')"
            and "¬v  set (delete_effects_of op')"
            by blast+
          thus ?thesis
            using map_of_effect_to_assignments_is_none_if[of v op'] m'_is
            by fastforce
        qed
    }
    ― ‹ TODO slow. ›
    ultimately show ?thesis
      unfolding execute_parallel_operator_def
      using foldl_map_append_is_some_if[of s v True ?l]
      by meson
  qed

lemma execute_parallel_operator_negative_effect_if_i:
  assumes "are_all_operators_applicable s ops"
    and "are_all_operator_effects_consistent ops"
    and "op  set ops"
    and "v  set (delete_effects_of op)"
  shows "map_of (effect_to_assignments op) v = Some False"
  proof -
    let ?f = "λx. if ListMem x (delete_effects_of op) then False else True"
      and ?l'= " map (λv. (v, if ListMem v (delete_effects_of op) then False else True))
        (add_effects_of op @ delete_effects_of op)"
    have "set (delete_effects_of op @ add_effects_of op)  {}"
      using assms(4)
      by fastforce
    moreover have "v  set (delete_effects_of op @ add_effects_of op)"
      using assms(4)
      by simp
    moreover {
      have "set (add_effects_of op)  set (delete_effects_of op) = {}"
        using are_all_operator_effects_consistent_set assms(2, 3)
        by fast
      moreover have "effect_to_assignments op = ?l'"
        using effect_to_assignments_construction_from_function_graph(2) calculation
        by blast
      ultimately have "map_of (effect_to_assignments op) = map_of ?l'"
        by argo
    }
    ultimately have "map_of (effect_to_assignments op) v = Some (?f v)"
      using Map_Supplement.map_of_from_function_graph_is_some_if[
          of "add_effects_of op @ delete_effects_of op" v "?f"]
      by force
    thus ?thesis
      using assms(4)
      unfolding ListMem_iff
      by presburger
  qed

lemma execute_parallel_operator_negative_effect_if:
  assumes "are_all_operators_applicable s ops"
    and "are_all_operator_effects_consistent ops"
    and "op  set ops"
    and "v  set (delete_effects_of op)"
  shows "execute_parallel_operator s ops v = Some False"
  proof -
    let ?l = "map (map_of  effect_to_assignments) ops"
    have set_l_is: "set ?l = (map_of  effect_to_assignments) ` set ops"
      using set_map
      by fastforce
    {
      let ?m = "(map_of  effect_to_assignments) op"
      have "?m  set ?l"
        using assms(3) set_l_is
        by blast
      moreover have "?m v = Some False"
        using execute_parallel_operator_negative_effect_if_i[OF assms]
        by fastforce
      ultimately have "m  set ?l. m v = Some False"
        by blast
    }
    moreover {
      fix m'
      assume "m'  set ?l"
      then obtain op'
        where op'_in_set_ops: "op'  set ops"
          and m'_is: "m' = (map_of  effect_to_assignments) op'"
        by auto
      then have "set (delete_effects_of op)  set (add_effects_of op') = {}"
        using assms(2, 3) are_all_operator_effects_consistent_set[of ops]
        by blast
      then have "v  set (add_effects_of op')"
        using assms(4)
        by blast
      then consider (v_in_set_delete_effects) "v  set (delete_effects_of op')"
        | (otherwise) "¬v  set (add_effects_of op')  ¬v  set (delete_effects_of op')"
        by blast
      hence "m' v = Some False  m' v = None"
        proof (cases)
          case v_in_set_delete_effects
          ― ‹ TODO slow. ›
          thus ?thesis
            using execute_parallel_operator_negative_effect_if_i[
                OF assms(1, 2) op'_in_set_ops, of v] m'_is
            by simp
        next
          case otherwise
          then have "¬v  set (add_effects_of op')"
            and "¬v  set (delete_effects_of op')"
            by blast+
          thus ?thesis
            using map_of_effect_to_assignments_is_none_if[of v op'] m'_is
            by fastforce
        qed
    }
    ― ‹ TODO slow. ›
    ultimately show ?thesis
      unfolding execute_parallel_operator_def
      using foldl_map_append_is_some_if[of s v False ?l]
      by meson
  qed

lemma execute_parallel_operator_no_effect_if:
  assumes "op  set ops. ¬v  set (add_effects_of op)  ¬v  set (delete_effects_of op)"
  shows "execute_parallel_operator s ops v = s v"
  using assms
  unfolding execute_parallel_operator_def
  proof (induction ops arbitrary: s)
    case (Cons a ops)
    let ?f = "map_of  effect_to_assignments"
    {
      have "v  set (add_effects_of a)  v  set (delete_effects_of a)"
        using Cons.prems(1)
        by force
      then have "?f a v = None"
        using map_of_effect_to_assignments_is_none_if[of v a]
        by fastforce
      then have "v  dom (?f a)"
        by blast
      hence "(s ++ ?f a) v = s v"
        using map_add_dom_app_simps(3)[of v "?f a" s]
        by blast
    }
    moreover {
      have "opset ops. v  set (add_effects_of op)  v  set (delete_effects_of op)"
        using Cons.prems(1)
        by simp
      hence "foldl (++) (s ++ ?f a) (map ?f ops) v = (s ++ ?f a) v"
        using Cons.IH[of "s ++ ?f a"]
        by blast
    }
    moreover {
      have "map ?f (a # ops) = ?f a # map ?f ops"
        by force
      then have "foldl (++) s (map ?f (a # ops))
        = foldl (++) (s ++ ?f a) (map ?f ops)"
        using foldl_Cons
        by force
    }
    ultimately show ?case
      by argo
  qed fastforce

corollary execute_parallel_operators_strips_none_if:
  assumes "op  set ops. ¬v  set (add_effects_of op)  ¬v  set (delete_effects_of op)"
    and "s v = None"
  shows "execute_parallel_operator s ops v = None"
  using execute_parallel_operator_no_effect_if[OF assms(1)] assms(2)
  by simp

corollary execute_parallel_operators_strips_none_if_contraposition:
  assumes "¬execute_parallel_operator s ops v = None"
  shows "(op  set ops. v  set (add_effects_of op)  v  set (delete_effects_of op))
     s v  None"
  proof -
    let ?P = "(op  set ops. ¬v  set (add_effects_of op)  ¬v  set (delete_effects_of op))
       s v = None"
      and ?Q = "execute_parallel_operator s ops v = None"
    have "?P  ?Q"
      using execute_parallel_operators_strips_none_if[of ops v s]
      by blast
    then have "¬?P"
      using contrapos_nn[of ?Q ?P]
      using assms
      by argo
    thus ?thesis
      by meson
  qed

text ‹ We will now move on to showing the equivalent to theorem \isaname{operator_effect__strips}
in \isaname{execute_parallel_operator_effect}.
Under the condition that for a list of operators termops all
operators in the corresponding set are applicable in a given state terms and all operator effects
are consistent, if an operator termop exists with termop  set ops and with termv being
an add effect of termop, then the successor state

  @{text[display, indent=4] "s' ≡ execute_parallel_operator s ops"}

will evaluate termv to true, that is

  @{text[display, indent=4] "execute_parallel_operator s ops v = Some True"}

Symmetrically, if termv is a delete effect, we have

  @{text[display, indent=4] "execute_parallel_operator s ops v = Some False"}

under the same condition as for the positive effect.
Lastly, if termv is neither an add effect nor a delete effect for any operator in the
operator set corresponding to $ops$, then the state after parallel operator execution remains
unchanged, i.e.

  @{text[display, indent=4] "execute_parallel_operator s ops v = s v"}

theorem  execute_parallel_operator_effect:
  assumes "are_all_operators_applicable s ops"
  and "are_all_operator_effects_consistent ops"
shows "op  set ops  v  set (add_effects_of op)
   execute_parallel_operator s ops v = Some True"
  and "op  set ops  v  set (delete_effects_of op)
     execute_parallel_operator s ops v = Some False"
  and "(op  set ops.
    v  set (add_effects_of op)  v  set (delete_effects_of op))
     execute_parallel_operator s ops v = s v"
  using execute_parallel_operator_positive_effect_if[OF assms]
    execute_parallel_operator_negative_effect_if[OF assms]
    execute_parallel_operator_no_effect_if[of ops v s]
  by blast+


lemma is_parallel_solution_for_problem_operator_set:
  fixes Π:: "'a strips_problem"
  assumes "is_parallel_solution_for_problem Π π"
    and "ops  set π"
    and "op  set ops"
  shows "op  set ((Π)𝒪)"
  proof -
    have "ops  set π. op  set ops. op  set (strips_problem.operators_of Π)"
      using assms(1)
      unfolding is_parallel_solution_for_problem_def list_all_iff ListMem_iff..
    thus ?thesis
      using assms(2, 3)
      by fastforce
  qed

lemma trace_parallel_plan_strips_not_nil: "trace_parallel_plan_strips I π  []"
  proof (cases π)
    case (Cons a list)
    then show ?thesis
      by (cases "are_all_operators_applicable I (hd π)  are_all_operator_effects_consistent (hd π)"
        , simp+)
  qed simp

corollary length_trace_parallel_plan_gt_0[simp]: "0 < length (trace_parallel_plan_strips I π)"
  using trace_parallel_plan_strips_not_nil..

corollary length_trace_minus_one_lt_length_trace[simp]:
  "length (trace_parallel_plan_strips I π) - 1 < length (trace_parallel_plan_strips I π)"
  using diff_less[OF _ length_trace_parallel_plan_gt_0]
  by auto

lemma trace_parallel_plan_strips_head_is_initial_state:
  "trace_parallel_plan_strips I π ! 0 = I"
  proof  (cases π)
    case (Cons a list)
    then show ?thesis
      by (cases "are_all_operators_applicable I a  are_all_operator_effects_consistent a", simp+)
  qed simp

lemma trace_parallel_plan_strips_length_gt_one_if:
  assumes "k < length (trace_parallel_plan_strips I π) - 1"
  shows "1 < length (trace_parallel_plan_strips I π)"
  using assms
  by linarith

― ‹ This lemma simply shows that the last element of a trace_parallel_plan_strips execution›
step s # trace_parallel_plan_strips s' π› always is the last element of
trace_parallel_plan_strips s' π› since trace_parallel_plan_strips› always returns at least a
singleton list (even if π = []›). ›
lemma trace_parallel_plan_strips_last_cons_then:
  "last (s # trace_parallel_plan_strips s' π) = last (trace_parallel_plan_strips s' π)"
  by (cases π, simp, force)

text ‹ Parallel plan traces have some important properties that we want to confirm before
proceeding. Let termτ  trace_parallel_plan_strips I π be a trace for a parallel plan termπ
with initial state termI.

First, all parallel operators termops = π ! k for any index termk with termk < length τ - 1
(meaning that termk is not the index of the last element).
must be applicable and their effects must be consistent. Otherwise, the trace would have terminated
and termops would have been the last element. This would violate the assumption that termk < length τ - 1
is not the last index since the index of the last element is term‹length τ - 1.
\footnote{More precisely, the index of the last element is term‹length τ - 1 if termτ is not
empty which is however always true since the trace contains at least the initial state.} ›

(* TODO? hide? *)
lemma  trace_parallel_plan_strips_operator_preconditions:
  assumes "k < length (trace_parallel_plan_strips I π) - 1"
  shows "are_all_operators_applicable (trace_parallel_plan_strips I π ! k) (π ! k)
       are_all_operator_effects_consistent (π ! k)"
  using assms
  proof  (induction "π" arbitrary: I k)
    ― ‹ NOTE Base case yields contradiction with assumption and can be left to automation. ›
    case (Cons a π)
    then show ?case
      proof (cases "are_all_operators_applicable I a  are_all_operator_effects_consistent a")
        case True
        have trace_parallel_plan_strips_cons: "trace_parallel_plan_strips I (a # π)
          = I # trace_parallel_plan_strips (execute_parallel_operator I a) π"
          using True
          by simp
        then show ?thesis
        proof (cases "k")
          case 0
          have "trace_parallel_plan_strips I (a # π) ! 0 = I"
            using trace_parallel_plan_strips_cons
            by simp
          moreover have "(a # π) ! 0 = a"
            by simp
          ultimately show ?thesis
            using True 0
            by presburger
        next
          case (Suc k')
          let ?I' = "execute_parallel_operator I a"
          have "trace_parallel_plan_strips I (a # π) ! Suc k' = trace_parallel_plan_strips ?I' π ! k'"
            using trace_parallel_plan_strips_cons
            by simp
          moreover have "(a # π) ! Suc k' = π ! k'"
            by simp
          moreover {
            have "length (trace_parallel_plan_strips I (a # π))
              = 1 + length (trace_parallel_plan_strips ?I' π)"
              unfolding trace_parallel_plan_strips_cons
              by simp
            then have "k' < length (trace_parallel_plan_strips ?I' π) - 1"
              using Suc Cons.prems
              by fastforce
            hence "are_all_operators_applicable (trace_parallel_plan_strips ?I' π ! k') (π ! k')
             are_all_operator_effects_consistent (π ! k')"
              using Cons.IH[of k']
              by blast
          }
          ultimately show ?thesis
            using Suc
            by argo
        qed
      next
        case False
        then have "trace_parallel_plan_strips I (a # π) = [I]"
          by force
        then have "length (trace_parallel_plan_strips I (a # π)) - 1 = 0"
          by simp
        ― ‹ NOTE Thesis follows from contradiction with assumption. ›
        then show ?thesis
          using Cons.prems
          by force
      qed
  qed auto

text ‹ Another interesting property that we verify below is that elements of the trace
store the result of plan prefix execution. This means that for an index termk with\newline
termk < length (trace_parallel_plan_strips I π), the termk-th element of the trace is state
reached by executing the plan prefix term‹take k π consisting of the first termk parallel
operators of termπ. ›

lemma  trace_parallel_plan_plan_prefix:
  assumes "k < length (trace_parallel_plan_strips I π)"
  shows "trace_parallel_plan_strips I π ! k = execute_parallel_plan I (take k π)"
  using assms
  proof  (induction π arbitrary: I k)
    case (Cons a π)
    then show ?case
      proof (cases "are_all_operators_applicable I a  are_all_operator_effects_consistent a")
        case True
        let  = "trace_parallel_plan_strips I (a # π)"
          and ?I' = "execute_parallel_operator I a"
        have σ_equals: " = I # trace_parallel_plan_strips ?I' π"
          using True
          by auto
        then show ?thesis
          proof (cases "k = 0")
            case False
            obtain k' where k_is_suc_of_k': "k = Suc k'"
              using not0_implies_Suc[OF False]
              by blast
            then have "execute_parallel_plan I (take k (a # π))
              = execute_parallel_plan ?I' (take k' π)"
              using True
              by simp
            moreover have "trace_parallel_plan_strips I (a # π) ! k
              = trace_parallel_plan_strips ?I' π ! k'"
              using σ_equals k_is_suc_of_k'
              by simp
            moreover {
              have "k' < length (trace_parallel_plan_strips (execute_parallel_operator I a) π)"
                using Cons.prems σ_equals k_is_suc_of_k'
                by force
              hence "trace_parallel_plan_strips ?I' π ! k'
                = execute_parallel_plan ?I' (take k' π)"
                using Cons.IH[of k' ?I']
                by blast
            }
            ultimately show ?thesis
              by presburger
          qed simp
      next
        case operator_precondition_violated: False
        then show ?thesis
        proof (cases "k = 0")
          case False
          then have "trace_parallel_plan_strips I (a # π) = [I]"
            using operator_precondition_violated
            by force
          moreover have "execute_parallel_plan I (take k (a # π)) = I"
            using Cons.prems operator_precondition_violated
            by force
          ultimately show ?thesis
            using Cons.prems nth_Cons_0
            by auto
        qed simp
      qed
  qed simp


lemma length_trace_parallel_plan_strips_lte_length_plan_plus_one:
  shows "length (trace_parallel_plan_strips I π)  length π + 1"
  proof (induction π arbitrary: I)
    case (Cons a π)
    then show ?case
      proof (cases "are_all_operators_applicable I a  are_all_operator_effects_consistent a")
        case True
        let ?I' = "execute_parallel_operator I a"
        {
          have "trace_parallel_plan_strips I (a # π) = I # trace_parallel_plan_strips ?I' π"
            using True
            by auto
          then have "length (trace_parallel_plan_strips I (a # π))
            = length (trace_parallel_plan_strips ?I' π) + 1"
            by simp
          moreover have "length (trace_parallel_plan_strips ?I' π)  length π + 1"
            using Cons.IH[of ?I']
            by blast
          ultimately have "length (trace_parallel_plan_strips I (a # π))  length (a # π) + 1"
            by simp
        }
        thus ?thesis
          by blast
      qed auto
  qed simp

― ‹ Show that π› is at least a singleton list. ›
lemma plan_is_at_least_singleton_plan_if_trace_has_at_least_two_elements:
  assumes "k < length (trace_parallel_plan_strips I π) - 1"
  obtains ops π' where "π = ops # π'"
  proof -
    let  = "trace_parallel_plan_strips I π"
    have "length   length π + 1"
      using length_trace_parallel_plan_strips_lte_length_plan_plus_one
      by fast
    then have "0 < length π"
      using trace_parallel_plan_strips_length_gt_one_if assms
      by force
    then obtain k' where "length π = Suc k'"
      using gr0_implies_Suc
      by meson
    thus ?thesis using that
      using length_Suc_conv[of π k']
      by blast
  qed

― ‹ Show that if a parallel plan trace does not have maximum length, in the last state
reached through operator execution the parallel operator execution condition was violated. ›
corollary length_trace_parallel_plan_strips_lt_length_plan_plus_one_then:
  assumes "length (trace_parallel_plan_strips I π) < length π + 1"
  shows "¬are_all_operators_applicable
      (execute_parallel_plan I (take (length (trace_parallel_plan_strips I π) - 1) π))
      (π ! (length (trace_parallel_plan_strips I π) - 1))
     ¬are_all_operator_effects_consistent (π ! (length (trace_parallel_plan_strips I π) - 1))"
  using assms
  proof (induction π arbitrary: I)
    case (Cons ops π)
    let  = "trace_parallel_plan_strips I (ops # π)"
      and ?I' = "execute_parallel_operator I ops"
    show ?case
      proof (cases "are_all_operators_applicable I ops  are_all_operator_effects_consistent ops")
        case True
        then have τ_is: " = I # trace_parallel_plan_strips ?I' π"
          by fastforce
        show ?thesis
          proof (cases "length (trace_parallel_plan_strips ?I' π) < length π + 1")
            case True
            then have "¬ are_all_operators_applicable
              (execute_parallel_plan ?I'
                (take (length (trace_parallel_plan_strips ?I' π) - 1) π))
              (π ! (length (trace_parallel_plan_strips ?I' π) - 1))
             ¬ are_all_operator_effects_consistent
              (π ! (length (trace_parallel_plan_strips ?I' π) - 1))"
              using Cons.IH[of ?I']
              by blast
            moreover have "trace_parallel_plan_strips ?I' π  []"
              using trace_parallel_plan_strips_not_nil
              by blast
            ultimately show ?thesis
              unfolding take_Cons'
              by simp
          next
            case False
            then have "length (trace_parallel_plan_strips ?I' π)  length π + 1"
              by fastforce
            thm Cons.prems
            moreover have "length (trace_parallel_plan_strips I (ops # π))
              = 1 + length (trace_parallel_plan_strips ?I' π)"
              using True
              by force
            moreover have "length (trace_parallel_plan_strips ?I' π)
              < length (ops # π)"
              using Cons.prems calculation(2)
              by force
            ultimately have False
              by fastforce
            thus ?thesis..
          qed
      next
        case False
        then have τ_is_singleton: " = [I]"
          using False
          by auto
        then have "ops = (ops # π) ! (length  - 1)"
          by fastforce
        moreover have "execute_parallel_plan I (take (length  - 1) π) = I"
          using τ_is_singleton
          by auto
        ― ‹ TODO slow. ›
        ultimately show ?thesis
          using False
          by auto
      qed
  qed simp

lemma trace_parallel_plan_step_effect_is:
  assumes "k < length (trace_parallel_plan_strips I π) - 1"
  shows "trace_parallel_plan_strips I π ! Suc k
    = execute_parallel_operator (trace_parallel_plan_strips I π ! k) (π ! k)"
  proof -
    ― ‹ NOTE Rewrite the proposition using lemma trace_parallel_plan_strips_subplan›. ›
    {
      let  = "trace_parallel_plan_strips I π"
      have "Suc k < length "
        using assms
        by linarith
      hence "trace_parallel_plan_strips I π ! Suc k
        = execute_parallel_plan I (take (Suc k) π)"
        using trace_parallel_plan_plan_prefix[of "Suc k" I π]
        by blast
    }
    moreover have "execute_parallel_plan I (take (Suc k) π)
      = execute_parallel_operator (trace_parallel_plan_strips I π ! k) (π ! k)"
      using assms
      proof (induction k arbitrary: I π)
        case 0
        then have "execute_parallel_operator (trace_parallel_plan_strips I π ! 0) (π ! 0)
            = execute_parallel_operator I (π ! 0)"
          using trace_parallel_plan_strips_head_is_initial_state[of I π]
          by argo
        moreover {
          obtain ops π' where "π = ops # π'"
            using plan_is_at_least_singleton_plan_if_trace_has_at_least_two_elements[OF "0.prems"]
            by blast
          then have "take (Suc 0) π = [π ! 0]"
            by simp
          hence "execute_parallel_plan I (take (Suc 0) π)
            = execute_parallel_plan I [π ! 0]"
            by argo
        }
        moreover {
          have "0 < length (trace_parallel_plan_strips I π) - 1"
            using trace_parallel_plan_strips_length_gt_one_if "0.prems"
            by fastforce
          hence "are_all_operators_applicable I (π ! 0)
             are_all_operator_effects_consistent (π ! 0)"
            using trace_parallel_plan_strips_operator_preconditions[of 0 I π]
              trace_parallel_plan_strips_head_is_initial_state[of I π]
            by argo
        }
        ultimately show ?case
          by auto
      next
        case (Suc k)
        obtain ops π' where π_split: "π = ops # π'"
          using plan_is_at_least_singleton_plan_if_trace_has_at_least_two_elements[OF Suc.prems]
          by blast
        let ?I' = "execute_parallel_operator I ops"
        {
          have "length (trace_parallel_plan_strips I π) =
            1 + length (trace_parallel_plan_strips ?I' π')"
            using Suc.prems π_split
            by fastforce
          then have "k < length (trace_parallel_plan_strips ?I' π')"
            using Suc.prems
            by fastforce
          moreover have "trace_parallel_plan_strips I π ! Suc k
            = trace_parallel_plan_strips ?I' π' ! k"
            using Suc.prems π_split
            by force
          ultimately have "trace_parallel_plan_strips I π ! Suc k
            = execute_parallel_plan ?I' (take k π')"
            using trace_parallel_plan_plan_prefix[of k ?I' π']
            by argo
        }
        moreover have "execute_parallel_plan I (take (Suc (Suc k)) π)
          = execute_parallel_plan ?I' (take (Suc k) π')"
          using Suc.prems π_split
          by fastforce
        moreover {
          have "0 < length (trace_parallel_plan_strips I π) - 1"
            using Suc.prems
            by linarith
          hence "are_all_operators_applicable I (π ! 0)
             are_all_operator_effects_consistent (π ! 0)"
            using trace_parallel_plan_strips_operator_preconditions[of 0 I π]
              trace_parallel_plan_strips_head_is_initial_state[of I π]
            by argo
        }
        ultimately show ?case
          using Suc.IH Suc.prems π_split
          by auto
      qed
    ultimately show ?thesis
      using assms
      by argo
  qed

― ‹ Show that every state in a plan execution trace of a valid problem description is defined
for all problem variables. This is true because the initial state is defined for all problem
variables—by definition of @{text "is_valid_problem_strips Π"}—and no operator can remove a
previously defined variable (only positive and negative effects are possible). ›
(* TODO refactor ‹STRIPS_Semantics› + abstract/concretize first two assumptions (e.g. second one
only needs all operators are problem operators)? *)
lemma trace_parallel_plan_strips_none_if:
  fixes Π:: "'a strips_problem"
  assumes "is_valid_problem_strips Π"
    and "is_parallel_solution_for_problem Π π"
    and "k < length (trace_parallel_plan_strips ((Π)I) π)"
  shows "(trace_parallel_plan_strips ((Π)I) π ! k) v = None  v  set ((Π)𝒱)"
  proof -
    let ?vs = "strips_problem.variables_of Π"
      and ?ops = "strips_problem.operators_of Π"
      and  = "trace_parallel_plan_strips ((Π)I) π"
      and ?I = "strips_problem.initial_of Π"
    show ?thesis
      using assms
      proof (induction k)
        case 0
        have " ! 0 = ?I"
          using trace_parallel_plan_strips_head_is_initial_state
          by auto
        then show ?case
          using is_valid_problem_strips_initial_of_dom[OF assms(1)]
          by auto
      next
        case (Suc k)
        have k_lt_length_τ_minus_one: "k < length  - 1"
          using Suc.prems(3)
          by linarith
        then have IH: "(trace_parallel_plan_strips ?I π ! k) v = None  v set ((Π)𝒱)"
          using Suc.IH[OF Suc.prems(1, 2)]
          by force
        have τ_Suc_k_is: "( ! Suc k) = execute_parallel_operator ( ! k) (π ! k)"
          using trace_parallel_plan_step_effect_is[OF k_lt_length_τ_minus_one].
        have all_operators_applicable: "are_all_operators_applicable ( ! k) (π ! k)"
          and all_effects_consistent: "are_all_operator_effects_consistent (π ! k)"
          using trace_parallel_plan_strips_operator_preconditions[OF k_lt_length_τ_minus_one]
          by simp+
        show ?case
          proof (rule iffI)
            assume τ_Suc_k_of_v_is_None: "( ! Suc k) v = None"
            show "v  set ((Π)𝒱)"
              proof (rule ccontr)
                assume "¬v  set ((Π)𝒱)"
                then have v_in_set_vs: "v  set((Π)𝒱)"
                  by blast
                show False
                  proof (cases "op  set (π ! k).
                    v  set (add_effects_of op)  v  set (delete_effects_of op)")
                    case True
                    then obtain op
                      where op_in_πk: "op  set (π ! k)"
                        and "v  set (add_effects_of op)  v  set (delete_effects_of op)"..
                    then consider (A) "v  set (add_effects_of op)"
                      | (B) "v  set (delete_effects_of op)"
                      by blast
                    thus False
                      using execute_parallel_operator_positive_effect_if[OF
                              all_operators_applicable all_effects_consistent op_in_πk]
                            execute_parallel_operator_negative_effect_if[OF
                              all_operators_applicable all_effects_consistent op_in_πk]
                            τ_Suc_k_of_v_is_None τ_Suc_k_is
                      by (cases, fastforce+)
                  next
                    case False
                    then have "op  set (π ! k).
                      v  set (add_effects_of op)  v  set (delete_effects_of op)"
                      by blast
                    then have "( ! Suc k) v = ( ! k) v"
                      using execute_parallel_operator_no_effect_if τ_Suc_k_is
                      by fastforce
                    then have "v  set ((Π)𝒱)"
                      using IH  τ_Suc_k_of_v_is_None
                      by simp
                    thus False
                      using v_in_set_vs
                      by blast
                  qed
              qed
          next
            assume v_notin_vs: "v  set ((Π)𝒱)"
            {
              fix op
              assume op_in_πk: "op  set (π ! k)"
              {
                have "1 < length "
                  using trace_parallel_plan_strips_length_gt_one_if[OF k_lt_length_τ_minus_one].
                then have "0 < length  - 1"
                  using k_lt_length_τ_minus_one
                  by linarith
                moreover have "length  - 1  length π"
                  using length_trace_parallel_plan_strips_lte_length_plan_plus_one le_diff_conv
                  by blast
                then have "k < length π"
                  using k_lt_length_τ_minus_one
                  by force
                hence "π ! k  set π"
                  by simp
              }
              then have op_in_ops: "op  set ?ops"
                using is_parallel_solution_for_problem_operator_set[OF assms(2) _ op_in_πk]
                by force
              hence "v  set (add_effects_of op)" and "v  set (delete_effects_of op)"
                subgoal
                  using is_valid_problem_strips_operator_variable_sets(2) assms(1) op_in_ops
                    v_notin_vs
                  by auto
                subgoal
                  using is_valid_problem_strips_operator_variable_sets(3) assms(1) op_in_ops
                    v_notin_vs
                  by auto
                done
            }
            then have "( ! Suc k) v = ( ! k) v"
              using execute_parallel_operator_no_effect_if τ_Suc_k_is
              by metis
            thus "( ! Suc k) v = None"
              using IH v_notin_vs
              by fastforce
          qed
      qed
  qed

text ‹ Finally, given initial and goal states termI and termG, we can show that it's
equivalent to say that termπ is a solution for termI and termG---i.e.
termG m execute_parallel_plan I π---and
that the goal state is subsumed by the last element of the trace of termπ with initial state
termI. ›

lemma  execute_parallel_plan_reaches_goal_iff_goal_is_last_element_of_trace:
  "G m execute_parallel_plan I π
     G m last (trace_parallel_plan_strips I π)"
  proof  -
    let ?LHS = "G m execute_parallel_plan I π"
      and ?RHS = "G m last (trace_parallel_plan_strips I π)"
    show ?thesis
      proof (rule iffI)
        assume ?LHS
        thus ?RHS
          proof (induction π arbitrary: I)
            ― ‹ NOTE Nil case follows from simplification. ›
            case (Cons a π)
            thus ?case
              using Cons.prems
              proof (cases "are_all_operators_applicable I a  are_all_operator_effects_consistent a")
                case True
                let ?I' = "execute_parallel_operator I a"
                {
                  have "execute_parallel_plan I (a # π) = execute_parallel_plan ?I' π"
                    using True
                    by auto
                  then have "G m execute_parallel_plan ?I' π"
                    using Cons.prems
                    by presburger
                  hence "G m last (trace_parallel_plan_strips ?I' π)"
                    using Cons.IH[of ?I']
                    by blast
                }
                moreover {
                  have "trace_parallel_plan_strips I (a # π)
                    = I # trace_parallel_plan_strips ?I' π"
                    using True
                    by simp
                  then have "last (trace_parallel_plan_strips I (a # π))
                    = last (I # trace_parallel_plan_strips ?I' π)"
                    by argo
                  hence "last (trace_parallel_plan_strips I (a # π))
                    = last (trace_parallel_plan_strips ?I' π)"
                    using trace_parallel_plan_strips_last_cons_then[of I ?I' π]
                    by argo
                }
                ultimately show ?thesis
                  by argo
              qed force
            qed simp
      next
        assume ?RHS
        thus ?LHS
          proof (induction π arbitrary: I)
            ― ‹ NOTE Nil case follows from simplification. ›
            case (Cons a π)
            thus ?case
              proof (cases "are_all_operators_applicable I a  are_all_operator_effects_consistent a")
                case True
                let ?I' = "execute_parallel_operator I a"
                {
                  have "trace_parallel_plan_strips I (a # π) = I # (trace_parallel_plan_strips ?I' π)"
                    using True
                    by simp
                  then have "last (trace_parallel_plan_strips I (a # π))
                    = last (trace_parallel_plan_strips ?I' π)"
                    using trace_parallel_plan_strips_last_cons_then[of I ?I' π]
                    by argo
                  hence "G m last (trace_parallel_plan_strips ?I' π)"
                    using Cons.prems
                    by argo
                }
                thus ?thesis
                  using True Cons
                  by simp
              next
                case False
                then have "last (trace_parallel_plan_strips I (a # π)) = I"
                  and "execute_parallel_plan I (a # π) = I"
                  by (fastforce, force)
                thus ?thesis
                  using Cons.prems
                  by argo
              qed
          qed fastforce
      qed
  qed

subsection "Serializable Parallel Plans"

text ‹ With the groundwork on parallel and serial execution of STRIPS in place we can now address
the question under which conditions a parallel solution to a problem corresponds to a serial
solution and vice versa.
As we will see (in theorem \ref{isathm:embedding-serial-strips-plan}), while a serial plan can
be trivially rewritten as a parallel plan consisting of singleton operator list for each operator
in the plan, the condition for parallel plan solutions also involves non interference. ›


― ‹ Given that non interference implies that operator execution order can be switched
arbitrarily, it stands to reason that parallel operator execution can be serialized if non
interference is mandated in addition to the regular parallel execution condition (applicability and
effect consistency). This is in fact true as we show in the lemma below
\footnote{In the source literatur it is required that $\mathrm{app}_S(s)$ is defined which requires that
$\mathrm{app}_o(s)$ is defined for every $o \in S$. This again means that the preconditions
hold in $s$ and the set of effects is consistent which translates to the execution condition
in execute_parallel_operator›.
\cite[Lemma 2.11., p.1037]{DBLP:journals/ai/RintanenHN06}

Also, the proposition \cite[Lemma 2.11., p.1037]{DBLP:journals/ai/RintanenHN06} is in fact
proposed to be true for any total ordering of the operator set but we only proof it for the
implicit total ordering induced by the specific order in the operator list of the problem
statement.} ›
(* TODO rename execute_parallel_operator_equals_execute_serial_if *)
lemma execute_parallel_operator_equals_execute_sequential_strips_if:
  fixes s :: "('variable, bool) state"
  assumes "are_all_operators_applicable s ops"
    and "are_all_operator_effects_consistent ops"
    and "are_all_operators_non_interfering ops"
  shows "execute_parallel_operator s ops = execute_serial_plan s ops"
  using assms
  proof (induction ops arbitrary: s)
    case Nil
    have "execute_parallel_operator s Nil
      = foldl (++) s (map (map_of  effect_to_assignments) Nil)"
      using Nil.prems(1,2)
      unfolding execute_parallel_operator_def
      by presburger
    also have " = s"
      by simp
    finally have "execute_parallel_operator s Nil = s"
      by blast
    moreover have "execute_serial_plan s Nil = s"
      by auto
    ultimately show ?case
      by simp
  next
    case (Cons a ops)
    ― ‹ NOTE Use the preceding lemmas to show that the premises hold for the sublist and use the IH
  to obtain the theorem for the sublist ops. ›
    have a: "is_operator_applicable_in s a"
      using are_all_operators_applicable_cons Cons.prems(1)
      by blast+
    let ?s' = "s ++ map_of (effect_to_assignments a)"
    {
      from Cons.prems
      have "are_all_operators_applicable ?s' ops"
        and "are_all_operator_effects_consistent ops"
        and "are_all_operators_non_interfering ops"
        using execute_parallel_plan_precondition_cons
        by blast+
      then have "execute_serial_plan ?s' ops
        = execute_parallel_operator ?s' ops"
        using Cons.IH
        by presburger
    }
    moreover from Cons.prems
    have "execute_parallel_operator s (Cons a ops)
      = execute_parallel_operator ?s' ops"
      using execute_parallel_operator_cons_equals_corollary
      unfolding execute_operator_def
      by simp
    moreover
    from a have "execute_serial_plan s (Cons a ops)
      = execute_serial_plan ?s' ops"
      unfolding execute_serial_plan_def execute_operator_def
        is_operator_applicable_in_def
      by fastforce
    ultimately show ?case
      by argo
  qed

lemma execute_serial_plan_split_i:
  assumes "are_all_operators_applicable s (op # π)"
    and "are_all_operators_non_interfering (op # π)"
  shows "are_all_operators_applicable (s  op) π"
  using assms
  proof (induction π arbitrary: s)
    case Nil
    then show ?case
      unfolding are_all_operators_applicable_def
      by simp
  next
    case (Cons op' π)
    let ?t = "s  op"
    {
      fix x
      assume "x  set (op' # π)"
      moreover have "op  set (op # op' # π)"
        by simp
      moreover have "¬are_operators_interfering op x"
        using Cons.prems(2) calculation(1)
        unfolding are_all_operators_non_interfering_def list_all_iff
        by fastforce
      moreover have "is_operator_applicable_in s op"
        using Cons.prems(1)
        unfolding are_all_operators_applicable_def list_all_iff
          is_operator_applicable_in_def
        by force
      moreover have "is_operator_applicable_in s x"
        using are_all_operators_applicable_cons(2)[OF Cons.prems(1)] calculation(1)
        unfolding are_all_operators_applicable_def list_all_iff
          is_operator_applicable_in_def
        by fast
      ultimately have "is_operator_applicable_in ?t x"
        using execute_parallel_plan_precondition_cons_i[of op x s]
        by (auto simp: execute_operator_def)
    }
    thus ?case
      using are_all_operators_applicable_cons(2)
      unfolding is_operator_applicable_in_def
        STRIPS_Representation.is_operator_applicable_in_def
        are_all_operators_applicable_def list_all_iff
      by simp
  qed

― ‹ Show that plans $\pi$ can be split into separate executions of partial plans $\pi_1$ and
$\pi_2$ with $\pi = \pi_1 @ \pi_2$, if all operators in $\pi_1$ are applicable in the given state
$s$ and there is no interference between subsequent operators in $\pi_1$. This is the case because
non interference ensures that no precondition for any operator in $\pi_1$ is negated by the
execution of a preceding operator. Note that the non interference constraint excludes partial
plans where a precondition is first violated during execution but later restored which would also
allow splitting but does not meet the non interference constraint (which must hold for all
possible executing orders). ›
lemma execute_serial_plan_split:
  fixes s :: "('variable, bool) state"
  assumes "are_all_operators_applicable s π1"
    and "are_all_operators_non_interfering π1"
  shows "execute_serial_plan s (π1 @ π2)
    = execute_serial_plan (execute_serial_plan s π1) π2"
  using assms
  proof (induction π1 arbitrary: s)
    case (Cons op π1)
    let ?t = "s  op"
    {
      have "are_all_operators_applicable (s  op) π1"
        using execute_serial_plan_split_i[OF Cons.prems(1, 2)].
      moreover have "are_all_operators_non_interfering π1"
        using are_all_operators_non_interfering_tail[OF Cons.prems(2)].
      ultimately have "execute_serial_plan ?t (π1 @ π2) =
        execute_serial_plan (execute_serial_plan ?t π1) π2"
        using Cons.IH[of ?t]
        by blast
    }
    moreover have "STRIPS_Representation.is_operator_applicable_in s op"
      using Cons.prems(1)
      unfolding are_all_operators_applicable_def list_all_iff
      by fastforce
    ultimately show ?case
      unfolding execute_serial_plan_def
      by simp
  qed simp

(* TODO refactor *)
lemma embedding_lemma_i:
  fixes I :: "('variable, bool) state"
  assumes "is_operator_applicable_in I op"
    and "are_operator_effects_consistent op op"
  shows "I  op = execute_parallel_operator I [op]"
  proof -
    have "are_all_operators_applicable I [op]"
      using assms(1)
      unfolding are_all_operators_applicable_def list_all_iff is_operator_applicable_in_def
      by fastforce
    moreover have "are_all_operator_effects_consistent [op]"
      unfolding are_all_operator_effects_consistent_def list_all_iff
      using assms(2)
      by fastforce
    moreover have "are_all_operators_non_interfering [op]"
      by simp
    moreover have "I  op = execute_serial_plan I [op]"
      using assms(1)
      unfolding  is_operator_applicable_in_def
      by (simp add: assms(1) execute_operator_def)
    ultimately show ?thesis
      using execute_parallel_operator_equals_execute_sequential_strips_if
      by force
  qed

lemma execute_serial_plan_is_execute_parallel_plan_ii:
  fixes I :: "'variable strips_state"
  assumes "op  set π. are_operator_effects_consistent op op"
    and "G m execute_serial_plan I π"
  shows "G m execute_parallel_plan I (embed π)"
  proof -
    show ?thesis
      using assms
      proof (induction π arbitrary: I)
        case (Cons op π)
        then show ?case
          proof (cases "is_operator_applicable_in I op")
            case True
            let ?J = "I  op"
              and ?J' = "execute_parallel_operator I [op]"
            {
              have "G m execute_serial_plan ?J π"
                using Cons.prems(2) True
                unfolding is_operator_applicable_in_def
                by (simp add: True)
              hence "G m execute_parallel_plan ?J (embed π)"
                using Cons.IH[of ?J] Cons.prems(1)
                by fastforce
            }
            moreover {
              have "are_all_operators_applicable I [op]"
                using True
                unfolding are_all_operators_applicable_def list_all_iff
                  is_operator_applicable_in_def
                by fastforce
              moreover have "are_all_operator_effects_consistent [op]"
                unfolding are_all_operator_effects_consistent_def list_all_iff
                using Cons.prems(1)
                by fastforce
              moreover have "?J = ?J'"
                using execute_parallel_operator_equals_execute_sequential_strips_if[OF
                    calculation(1, 2)] Cons.prems(1) True
                unfolding  is_operator_applicable_in_def
                by (simp add: True)
              ultimately have "execute_parallel_plan I (embed (op # π))
                = execute_parallel_plan ?J (embed π)"
                by fastforce
            }
            ultimately show ?thesis
              by presburger
          next
            case False
            then have "G m I"
              using Cons.prems is_operator_applicable_in_def
              by simp
            moreover {
              have "¬are_all_operators_applicable I [op]"
                using False
                unfolding are_all_operators_applicable_def list_all_iff
                  is_operator_applicable_in_def
                by force
              hence "execute_parallel_plan I (embed (op # π)) = I"
                by simp
            }
            ultimately show ?thesis
              by presburger
          qed
      qed simp
  qed

lemma embedding_lemma_iii:
  fixes Π:: "'a strips_problem"
  assumes "op  set π. op  set ((Π)𝒪)"
  shows "ops  set (embed π). op  set ops. op  set ((Π)𝒪)"
  proof -
    (* TODO refactor *)
    have nb: "set (embed π) = { [op] | op. op  set π }"
      by (induction π; force)
    {
      fix ops
      assume "ops  set (embed π)"
      moreover obtain op where "op  set π" and "ops = [op]"
        using nb calculation
        by blast
      ultimately have "op  set ops. op  set ((Π)𝒪)"
        using assms(1)
        by simp
    }
    thus ?thesis..
  qed

text ‹ We show in the following theorem that---as mentioned---a serial solution termπ to a
STRIPS problem termΠ corresponds directly to a parallel solution obtained by embedding each operator
in termπ in a list (by use of function term‹embed›). The proof shows this by first
confirming that

    @{text[display, indent=4] "G ⊆m execute_serial_plan ((Π)I) π
    ⟹ G ⊆m execute_serial_plan ((Π)I) (embed π)"}

using lemma \isaname{execute_serial_plan_is_execute_parallel_plan_strip_ii}; and
moreover by showing that

    @{text[display, indent=4] "∀ops ∈ set (embed π). ∀op ∈ set ops. op ∈ (Π)𝒪"}

meaning that under the given assumptions, all parallel operators of the embedded serial plan are
again operators in the operator set of the problem. ›
theorem  embedding_lemma:
  assumes "is_valid_problem_strips Π"
    and "is_serial_solution_for_problem Π π"
  shows "is_parallel_solution_for_problem Π (embed π)"
  proof  -
    (* TODO refactor ‹STRIPS_Representation› (characterization of valid operator).
  *)have nb1: "op  set π. op  set ((Π)𝒪)"
      using assms(2)
      unfolding is_serial_solution_for_problem_def list_all_iff ListMem_iff operators_of_def
      by blast
    (* TODO refactor lemma is_valid_operator_strips_then
  *)      {
      fix op
      assume "op  set π"
      moreover have "op  set ((Π)𝒪)"
        using nb1 calculation
        by fast
      moreover have "is_valid_operator_strips Π op"
        using assms(1) calculation(2)
        unfolding is_valid_problem_strips_def is_valid_problem_strips_def list_all_iff operators_of_def
        by meson
      moreover have "list_all (λv. ¬ListMem v (delete_effects_of op)) (add_effects_of op)"
        and "list_all (λv. ¬ListMem v (add_effects_of op)) (delete_effects_of op)"
        using calculation(3)
        unfolding is_valid_operator_strips_def
        by meson+
      moreover have "¬list_ex (λv. ListMem v (delete_effects_of op)) (add_effects_of op)"
        and "¬list_ex (λv. ListMem v (add_effects_of op)) (delete_effects_of op)"
        using calculation(4, 5) not_list_ex_equals_list_all_not
        by blast+
      moreover have "¬list_ex (λv. list_ex ((=) v) (delete_effects_of op)) (add_effects_of op)"
        and "¬list_ex (λv. list_ex ((=) v) (add_effects_of op)) (delete_effects_of op)"
        using calculation(6, 7)
        unfolding list_ex_iff ListMem_iff
        by blast+
      ultimately have "are_operator_effects_consistent op op"
        unfolding are_operator_effects_consistent_def Let_def
        by blast
    } note nb2 = this
    moreover {
      have "(Π)G m execute_serial_plan ((Π)I) π"
        using assms(2)
        unfolding is_serial_solution_for_problem_def
        by simp
      hence "(Π)G m execute_parallel_plan ((Π)I) (embed π)"
        using execute_serial_plan_is_execute_parallel_plan_ii nb2
        by blast
    }
    moreover have "ops  set (embed π). op  set ops. op  set ((Π)𝒪)"
      using embedding_lemma_iii[OF nb1].
    ultimately show ?thesis
      unfolding is_parallel_solution_for_problem_def goal_of_def
        initial_of_def operators_of_def list_all_iff ListMem_iff
      by blast
  qed

lemma flattening_lemma_i:
  fixes Π:: "'a strips_problem"
  assumes "ops  set π. op  set ops. op  set ((Π)𝒪)"
  shows "op  set (concat π). op  set ((Π)𝒪)"
  proof -
    {
      fix op
      assume "op  set (concat π)"
      moreover have "op  (ops  set π. set ops)"
        using calculation
        unfolding set_concat.
      then obtain ops where "ops  set π" and "op  set ops"
        using UN_iff
        by blast
      ultimately have "op  set ((Π)𝒪)"
        using assms
        by blast
    }
    thus ?thesis..
  qed

lemma flattening_lemma_ii:
  fixes I :: "'variable strips_state"
  assumes "ops  set π. op. ops = [op]  is_valid_operator_strips Π op "
    and "G m execute_parallel_plan I π"
  shows "G m execute_serial_plan I (concat π)"
  proof -
    let ?π' = "concat π"
    (* TODO refactor lemma is_valid_operator_strips_then *)
    {
      fix op
      assume "is_valid_operator_strips Π op"
      moreover have "list_all (λv. ¬ListMem v (delete_effects_of op)) (add_effects_of op)"
        and "list_all (λv. ¬ListMem v (add_effects_of op)) (delete_effects_of op)"
        using calculation(1)
        unfolding is_valid_operator_strips_def
        by meson+
      moreover have "¬list_ex (λv. ListMem v (delete_effects_of op)) (add_effects_of op)"
        and "¬list_ex (λv. ListMem v (add_effects_of op)) (delete_effects_of op)"
        using calculation(2, 3) not_list_ex_equals_list_all_not
        by blast+
      moreover have "¬list_ex (λv. list_ex ((=) v) (delete_effects_of op)) (add_effects_of op)"
        and "¬list_ex (λv. list_ex ((=) v) (add_effects_of op)) (delete_effects_of op)"
        using calculation(4, 5)
        unfolding list_ex_iff ListMem_iff
        by blast+
      ultimately have "are_operator_effects_consistent op op"
        unfolding are_operator_effects_consistent_def Let_def
        by blast
    } note nb1 = this
    show ?thesis
      using assms
      proof (induction π arbitrary: I)
        case (Cons ops π)
        obtain op where ops_is: "ops = [op]" and is_valid_op: "is_valid_operator_strips Π op"
          using Cons.prems(1)
          by fastforce
        show ?case
          proof (cases "are_all_operators_applicable I ops")
            case True
            let ?J = "execute_parallel_operator I [op]"
              and ?J' = "I  op"
            have nb2: "is_operator_applicable_in I op"
              using True ops_is
              unfolding are_all_operators_applicable_def list_all_iff
                is_operator_applicable_in_def
              by simp
            have nb3: "are_operator_effects_consistent op op"
              using nb1[OF is_valid_op].
            {
              then have "are_all_operator_effects_consistent ops"
                unfolding are_all_operator_effects_consistent_def list_all_iff
                using ops_is
                by fastforce
              hence "G m execute_parallel_plan ?J π"
                using Cons.prems(2) ops_is True
                by fastforce
            }
            moreover have "execute_serial_plan I (concat (ops # π))
              = execute_serial_plan ?J' (concat π)"
              using ops_is nb2
              unfolding is_operator_applicable_in_def
              by (simp add: execute_operator_def nb2)
            moreover have "?J = ?J'"
              unfolding execute_parallel_operator_def execute_operator_def comp_apply
              by fastforce
            ultimately show ?thesis
              using Cons.IH Cons.prems
              by force
          next
            case False
            moreover have "G m I"
              using Cons.prems(2) calculation
              by force
            moreover {
              have "¬is_operator_applicable_in I op"
                using ops_is False
                unfolding are_all_operators_applicable_def list_all_iff
                  is_operator_applicable_in_def
                by fastforce
              hence "execute_serial_plan I (concat (ops # π)) = I"
                using ops_is is_operator_applicable_in_def
                by simp
            }
            ultimately show ?thesis
              by argo
          qed
      qed force
  qed

text ‹ The opposite direction is also easy to show if we can normalize the parallel plan to the
form of an embedded serial plan as shown below. ›

lemma flattening_lemma:
  assumes "is_valid_problem_strips Π"
    and "ops  set π. op. ops = [op]"
    and "is_parallel_solution_for_problem Π π"
  shows "is_serial_solution_for_problem Π (concat π)"
  proof  -
    let ?π' = "concat π"
    {
      have "ops  set π. op  set ops. op  set ((Π)𝒪)"
        using assms(3)
        unfolding is_parallel_solution_for_problem_def list_all_iff ListMem_iff
        by force
      hence "op  set ?π'. op  set ((Π)𝒪)"
        using flattening_lemma_i
        by blast
    }
    moreover {
      {
        fix ops
        assume "ops  set π"
        moreover obtain op where "ops = [op]"
          using assms(2) calculation
          by blast
        moreover have "op  set ((Π)𝒪)"
          using assms(3) calculation
          unfolding is_parallel_solution_for_problem_def list_all_iff ListMem_iff
          by force
        moreover have "is_valid_operator_strips Π op"
          using assms(1) calculation(3)
          unfolding is_valid_problem_strips_def Let_def list_all_iff ListMem_iff
          by simp
        ultimately have "op. ops = [op]  is_valid_operator_strips Π op"
          by blast
      }
      moreover have "(Π)G m execute_parallel_plan ((Π)I) π"
        using assms(3)
        unfolding is_parallel_solution_for_problem_def
        by simp
      ultimately have "(Π)G m execute_serial_plan ((Π)I) ?π'"
        using flattening_lemma_ii
        by blast
    }
    ultimately show "is_serial_solution_for_problem Π ?π'"
      unfolding is_serial_solution_for_problem_def list_all_iff ListMem_iff
      by simp
  qed


text ‹ Finally, we can obtain the important result that a parallel plan with a trace that
reaches the goal state of a given problem termΠ, and for which both the parallel operator execution
condition as well as non interference is assured at every point termk < length π, the flattening of
the parallel plan term‹concat π is a serial solution for the initial and goal state of the problem.
To wit, by lemma \ref{isathm:parallel-solution-trace-strips} we have

    @{text[display, indent=4] "(G ⊆m execute_parallel_plan I π)
      = (G ⊆m last (trace_parallel_plan_strips I π))"}

so the second assumption entails that termπ is a solution for the initial state and the goal state
of the problem. (which implicitely means that  termπ is a solution
for the inital state and goal state of the problem). The trace formulation is used in this case
because it allows us to write the---state dependent---applicability condition more succinctly. The
proof (shown below) is by structural induction on termπ with arbitrary initial state.›

(* TODO Demote to lemma; add theorem about problem solutions. Move text to theorem. *)
theorem  execute_parallel_plan_is_execute_sequential_plan_if:
  fixes I :: "('variable, bool) state"
  assumes "is_valid_problem Π"
    and "G m last (trace_parallel_plan_strips I π)"
    and "k < length π.
      are_all_operators_applicable (trace_parallel_plan_strips I π ! k) (π ! k)
       are_all_operator_effects_consistent (π ! k)
       are_all_operators_non_interfering (π ! k)"
  shows "G m execute_serial_plan I (concat π)"
  using assms
  proof (induction π arbitrary: I)
    case (Cons ops π)
    let ?ops' = "take (length ops) (concat (ops # π))"
    let ?J = "execute_parallel_operator I ops"
      and ?J' = "execute_serial_plan I ?ops'"
    {
      have "trace_parallel_plan_strips I π ! 0 = I" and "(ops # π) ! 0 = ops"
        unfolding trace_parallel_plan_strips_head_is_initial_state
        by simp+
      then have "are_all_operators_applicable I ops"
        and "are_all_operator_effects_consistent ops"
        and "are_all_operators_non_interfering ops"
        using Cons.prems(3)
        by auto+
      then have "trace_parallel_plan_strips I (ops # π)
        = I # trace_parallel_plan_strips ?J π"
        by fastforce
    } note nb = this
    {
      have "last (trace_parallel_plan_strips I (ops # π))
        = last (trace_parallel_plan_strips ?J π)"
        using trace_parallel_plan_strips_last_cons_then nb
        by metis
      hence "G m last (trace_parallel_plan_strips ?J π)"
        using Cons.prems(2)
        by force
    }
    moreover {
      fix k
      assume "k < length π"
      moreover have "k + 1 < length (ops # π)"
        using calculation
        by force
      moreover have "π ! k = (ops # π) ! (k + 1)"
        by simp
      ultimately have "are_all_operators_applicable
        (trace_parallel_plan_strips ?J π ! k) (π ! k)"
        and "are_all_operator_effects_consistent (π ! k)"
        and "are_all_operators_non_interfering (π ! k)"
        using Cons.prems(3) nb
        by force+
    }
    ultimately have "G m execute_serial_plan ?J (concat π)"
      using Cons.IH[OF Cons.prems(1), of ?J]
      by blast
    moreover {
      have "execute_serial_plan I (concat (ops # π))
        = execute_serial_plan ?J' (concat π)"
        using execute_serial_plan_split[of I ops] Cons.prems(3)
        by auto
      thm execute_parallel_operator_equals_execute_sequential_strips_if[of I]
      moreover have "?J = ?J'"
        using execute_parallel_operator_equals_execute_sequential_strips_if Cons.prems(3)
        by fastforce
      ultimately have "execute_serial_plan I (concat (ops # π))
        = execute_serial_plan ?J (concat π)"
        using execute_serial_plan_split[of I ops] Cons.prems(3)
        by argo
    }
    ultimately show ?case
      by argo
  qed force

subsection "Auxiliary lemmas about STRIPS"

lemma set_to_precondition_of_op_is[simp]: "set (to_precondition op)
  = { (v, True) | v. v  set (precondition_of op) }"
  unfolding to_precondition_def STRIPS_Representation.to_precondition_def set_map
  by blast


end

Theory SAS_Plus_Representation

(*
  Author: Mohammad Abdulaziz, Fred Kurz
*)
theory SAS_Plus_Representation
imports State_Variable_Representation
begin

section "SAS+ Representation"

text ‹ We now continue by defining a concrete implementation of SAS+.›

text ‹ SAS+ operators and SAS+ problems again use records. In contrast to STRIPS, the operator 
effect is contracted into a single list however since we now potentially deal with more than two 
possible values for each problem variable. ›

record  ('variable, 'domain) sas_plus_operator = 
  precondition_of :: "('variable, 'domain) assignment list" 
  effect_of :: "('variable, 'domain) assignment list" 

record  ('variable, 'domain) sas_plus_problem =
  variables_of :: "'variable list" ("(_𝒱+)" [1000] 999)
  operators_of :: "('variable, 'domain) sas_plus_operator list" ("(_𝒪+)" [1000] 999)
  initial_of :: "('variable, 'domain) state" ("(_I+)" [1000] 999)
  goal_of :: "('variable, 'domain) state" ("(_G+)" [1000] 999)
  range_of :: "'variable  'domain list"

definition range_of':: "('variable, 'domain) sas_plus_problem  'variable  'domain set"  ("+ _ _" 52)
  where
  "range_of' Ψ v 
     (case sas_plus_problem.range_of Ψ v of None  {} 
           | Some as  set as)"

definition to_precondition 
  :: "('variable, 'domain) sas_plus_operator  ('variable, 'domain) assignment list" 
  where "to_precondition  precondition_of"

definition to_effect 
  :: "('variable, 'domain) sas_plus_operator  ('variable, 'domain) Effect" 
  where "to_effect op  [(v, a) . (v, a)  effect_of op]"

type_synonym  ('variable, 'domain) sas_plus_plan 
  = "('variable, 'domain) sas_plus_operator list"

type_synonym  ('variable, 'domain) sas_plus_parallel_plan 
  = "('variable, 'domain) sas_plus_operator list list"

abbreviation  empty_operator 
  :: "('variable, 'domain) sas_plus_operator" ("ρ")
  where "empty_operator   precondition_of = [], effect_of = [] " 

definition is_valid_operator_sas_plus
  :: "('variable, 'domain) sas_plus_problem   ('variable, 'domain) sas_plus_operator  bool" 
  where "is_valid_operator_sas_plus Ψ op  let 
      pre = precondition_of op
      ; eff = effect_of op
      ; vs = variables_of Ψ
      ; D = range_of Ψ
    in list_all (λ(v, a). ListMem v vs) pre
       list_all (λ(v, a). (D v  None)  ListMem a (the (D v))) pre 
       list_all (λ(v, a). ListMem v vs) eff
       list_all (λ(v, a). (D v  None)  ListMem a (the (D v))) eff
       list_all (λ(v, a). list_all (λ(v', a'). v  v'  a = a') pre) pre
       list_all (λ(v, a). list_all (λ(v', a'). v  v'  a = a') eff) eff"

definition "is_valid_problem_sas_plus Ψ 
   let ops = operators_of Ψ
      ; vs = variables_of Ψ
      ; I = initial_of Ψ
      ; G = goal_of Ψ
      ; D = range_of Ψ
    in list_all (λv. D v  None) vs
     list_all (is_valid_operator_sas_plus Ψ) ops 
     (v. I v  None  ListMem v vs) 
     (v. I v  None  ListMem (the (I v)) (the (D v)))
     (v. G v  None  ListMem v (variables_of Ψ))
     (v. G v  None  ListMem (the (G v)) (the (D v)))" 

definition is_operator_applicable_in
  :: "('variable, 'domain) state 
     ('variable, 'domain) sas_plus_operator 
     bool"
  where "is_operator_applicable_in s op 
     map_of (precondition_of op) m s" 

(* TODO rename execute_operator_in *)
definition execute_operator_sas_plus
  :: "('variable, 'domain) state 
     ('variable, 'domain) sas_plus_operator
     ('variable, 'domain) state" (infixl "+" 52)
  where "execute_operator_sas_plus s op  s ++ map_of (effect_of op)"

― ‹ Set up simp rules to keep use of local parameters transparent within proofs (i.e. 
automatically substitute definitions). ›
lemma[simp]: 
  "is_operator_applicable_in s op = (map_of (precondition_of op) m s)" 
  "s + op = s ++ map_of (effect_of op)"
  unfolding initial_of_def goal_of_def variables_of_def range_of_def operators_of_def      
    SAS_Plus_Representation.is_operator_applicable_in_def
    SAS_Plus_Representation.execute_operator_sas_plus_def
  by simp+

lemma range_of_not_empty:
  "(sas_plus_problem.range_of Ψ v  None  sas_plus_problem.range_of Ψ v  Some [])
     (+ Ψ v)  {}"
  apply (cases "sas_plus_problem.range_of Ψ v")
  by (auto simp add: SAS_Plus_Representation.range_of'_def)

lemma is_valid_operator_sas_plus_then:
  fixes Ψ::"('v,'d) sas_plus_problem"
  assumes "is_valid_operator_sas_plus Ψ op"
  shows "(v, a)  set (precondition_of op). v  set ((Ψ)𝒱+)"
    and "(v, a)  set (precondition_of op). (+ Ψ v)  {}  a  + Ψ v" 
    and "(v, a)  set (effect_of op). v  set ((Ψ)𝒱+)"
    and "(v, a)  set (effect_of op). (+ Ψ v)  {}  a  + Ψ v" 
    and "(v, a)  set (precondition_of op). (v', a')  set (precondition_of op). v  v'  a = a'"
    and "(v, a)  set (effect_of op). 
      (v', a')  set (effect_of op). v  v'  a = a'"
proof -
  let ?vs = "sas_plus_problem.variables_of Ψ" 
    and ?pre = "precondition_of op"
    and ?eff = "effect_of op"
    and ?D = "sas_plus_problem.range_of Ψ"
  have "(v, a)set ?pre. v  set ?vs"
    and "(v, a)set ?pre.
          (?D v  None) 
          a  set (the (?D v))"
    and "(v, a)set ?eff. v  set ?vs"
    and "(v, a)set ?eff.
          (?D v  None) 
          a  set (the (?D v))"
    and "(v, a)set ?pre.
          (v', a')set ?pre. v  v'  a = a'"
    and "(v, a)set ?eff. 
      (v', a')set ?eff. v  v'  a = a'"
    using assms
    unfolding is_valid_operator_sas_plus_def Let_def list_all_iff ListMem_iff 
    by meson+
  moreover have "(v, a)  set ?pre. v  set ((Ψ)𝒱+)"
    and "(v, a)  set ?eff. v  set ((Ψ)𝒱+)"
    and "(v, a)  set ?pre. (v', a')  set ?pre. v  v'  a = a'"
    and "(v, a)  set ?eff. (v', a')  set ?eff. v  v'  a = a'" 
    using calculation 
    unfolding variables_of_def
    by blast+
  moreover {
    have "(v, a)  set ?pre. (?D v  None)  a  set (the (?D v))"
      using assms 
      unfolding is_valid_operator_sas_plus_def Let_def list_all_iff ListMem_iff
      by argo
    hence "(v, a)  set ?pre. ((+ Ψ v)  {})  a  + Ψ v" 
      using range_of'_def 
      by fastforce
  }
  moreover {
    have "(v, a)  set ?eff. (?D v  None)  a  set (the (?D v))"
      using assms 
      unfolding is_valid_operator_sas_plus_def Let_def list_all_iff ListMem_iff
      by argo
    hence "(v, a)  set ?eff. ((+ Ψ v)  {})  a  + Ψ v" 
      using range_of'_def
      by fastforce
  }
  ultimately show "(v, a)  set (precondition_of op). v  set ((Ψ)𝒱+)"
    and "(v, a)  set (precondition_of op). (+ Ψ v)  {}  a  + Ψ v" 
    and "(v, a)  set (effect_of op). v  set ((Ψ)𝒱+)"
    and "(v, a)  set (effect_of op). (+ Ψ v)  {}  a  + Ψ v" 
    and "(v, a)  set (precondition_of op). (v', a')  set (precondition_of op). v  v'  a = a'"
    and "(v, a)  set (effect_of op). 
      (v', a')  set (effect_of op). v  v'  a = a'" 
    by blast+
qed

(* TODO can be replaced by proof for sublocale? *)
lemma is_valid_problem_sas_plus_then:
  fixes Ψ::"('v,'d) sas_plus_problem"
  assumes "is_valid_problem_sas_plus Ψ"
  shows "v  set ((Ψ)𝒱+). (+ Ψ v)  {}"
    and "op  set ((Ψ)𝒪+). is_valid_operator_sas_plus Ψ op"
    and "dom ((Ψ)I+) = set ((Ψ)𝒱+)"
    and "v  dom ((Ψ)I+). the (((Ψ)I+) v)  + Ψ v"
    and "dom ((Ψ)G+)  set ((Ψ)𝒱+)"
    and "v  dom ((Ψ)G+). the (((Ψ)G+) v)  + Ψ v" 
proof -
  let ?vs = "sas_plus_problem.variables_of Ψ"
    and ?ops = "sas_plus_problem.operators_of Ψ"
    and ?I = "sas_plus_problem.initial_of Ψ"
    and ?G = "sas_plus_problem.goal_of Ψ"
    and ?D = "sas_plus_problem.range_of Ψ"
  {
    fix v 
    have "(?D v  None  ?D v  Some [])  ((+ Ψ v)  {})"
      by (cases "?D v"; (auto simp: range_of'_def))
  } note nb = this
  have nb1: "v  set ?vs. ?D v  None"
    and "op  set ?ops. is_valid_operator_sas_plus Ψ op"
    and "v. (?I v  None) = (v  set ?vs)"
    and nb2: "v. ?I v  None  the (?I v)  set (the (?D v))"
    and "v. ?G v  None  v  set ?vs"
    and nb3: "v. ?G v  None  the (?G v)  set (the (?D v))"
    using assms 
    unfolding SAS_Plus_Representation.is_valid_problem_sas_plus_def Let_def 
      list_all_iff ListMem_iff 
    by argo+
  then have G3: "op  set ((Ψ)𝒪+). is_valid_operator_sas_plus Ψ op"
    and G4: "dom ((Ψ)I+) = set ((Ψ)𝒱+)"
    and G5: "dom ((Ψ)G+)  set ((Ψ)𝒱+)"
    unfolding variables_of_def operators_of_def
    by auto+
  moreover {
    fix v
    assume "v  set ((Ψ)𝒱+)"
    then have "?D v  None"
      using nb1 
      by force+
  } note G6 = this
  moreover {
    fix v
    assume "v  dom ((Ψ)I+)"
    moreover have "((Ψ)I+) v  None"
      using calculation
      by blast+
    moreover {
      have "v  set ((Ψ)𝒱+)"
        using G4 calculation(1)
        by argo
      then have "sas_plus_problem.range_of Ψ v  None" 
        using range_of_not_empty
        unfolding range_of'_def
        using G6 
        by fast+
      hence "set (the (?D v)) = + Ψ v" 
        by (simp add: ‹sas_plus_problem.range_of Ψ v  None› option.case_eq_if range_of'_def)
    }
    ultimately have "the (((Ψ)I+) v)  + Ψ v"
      using nb2
      by force
  }
  moreover {
    fix v
    assume "v  dom ((Ψ)G+)"
    then have "((Ψ)G+) v  None"
      by blast
    moreover {
      have "v  set ((Ψ)𝒱+)"
        using G5 calculation(1)
        by fast
      then have "sas_plus_problem.range_of Ψ v  None" 
        using range_of_not_empty
        using G6
        by fast+
      hence "set (the (?D v)) = + Ψ v" 
        by (simp add: ‹sas_plus_problem.range_of Ψ v  None› option.case_eq_if range_of'_def)
    }
    ultimately have "the (((Ψ)G+) v)  + Ψ v"
      using nb3
      by auto
  }
  ultimately show "v  set ((Ψ)𝒱+). (+ Ψ v)  {}"
    and "op  set((Ψ)𝒪+). is_valid_operator_sas_plus Ψ op"
    and "dom ((Ψ)I+) = set ((Ψ)𝒱+)"
    and "v  dom ((Ψ)I+). the (((Ψ)I+) v)  + Ψ v"
    and "dom ((Ψ)G+)  set ((Ψ)𝒱+)"
    and "v  dom ((Ψ)G+). the (((Ψ)G+) v)  + Ψ v"
    by blast+
qed

end

Theory SAS_Plus_Semantics

(*
  Author: Mohammad Abdulaziz, Fred Kurz
*)
theory SAS_Plus_Semantics  
  imports "SAS_Plus_Representation" "List_Supplement"
    "Map_Supplement"
begin
section "SAS+ Semantics"


subsection "Serial Execution Semantics"

text ‹ Serial plan execution is implemented recursively just like in the STRIPS case. By and large, 
compared to definition \ref{isadef:plan-execution-strips}, we only substitute the operator 
applicability function with its SAS+ counterpart. ›

primrec execute_serial_plan_sas_plus
  where "execute_serial_plan_sas_plus s [] = s"
  | "execute_serial_plan_sas_plus s (op # ops) 
    = (if is_operator_applicable_in s op 
    then execute_serial_plan_sas_plus (execute_operator_sas_plus s op) ops
    else s)" 

text ‹ Similarly, serial SAS+ solutions are defined just like in STRIPS but based on the 
corresponding SAS+ definitions. ›

definition is_serial_solution_for_problem
  :: "('variable, 'domain) sas_plus_problem  ('variable, 'domain) sas_plus_plan  bool" 
  where "is_serial_solution_for_problem Ψ ψ
     let 
        I = sas_plus_problem.initial_of Ψ
        ; G = sas_plus_problem.goal_of Ψ
        ; ops = sas_plus_problem.operators_of Ψ
      in G m execute_serial_plan_sas_plus I ψ
         list_all (λop. ListMem op ops) ψ" 


context
begin

private lemma execute_operator_sas_plus_effect_i:
  assumes "is_operator_applicable_in s op"
    and "(v, a)  set (effect_of op). (v', a')  set (effect_of op).
      v  v'  a = a'"
    and"(v, a)  set (effect_of op)"
  shows "(s + op) v = Some a"
proof -
  let ?effect = "effect_of op"
  have "map_of ?effect v = Some a" 
    using map_of_constant_assignments_defined_if[OF assms(2, 3)] try0
    by blast
  thus ?thesis 
    unfolding execute_operator_sas_plus_def map_add_def
    by fastforce
qed
    
private lemma  execute_operator_sas_plus_effect_ii:
  assumes "is_operator_applicable_in s op"
    and "(v', a')  set (effect_of op). v'  v"
  shows "(s + op) v = s v"
proof -
  let ?effect = "effect_of op" 
  {
    have "v  fst ` set ?effect" 
      using assms(2)
      by fastforce
    then have "v  dom (map_of ?effect)"
      using dom_map_of_conv_image_fst[of ?effect]
      by argo
    hence "(s ++ map_of ?effect) v = s v" 
      using map_add_dom_app_simps(3)[of v "map_of ?effect" s]
      by blast
  }
  thus ?thesis 
    by fastforce
qed

text ‹ Given an operator termop that is applicable in a state terms and has a consistent set 
of effects (second assumption) we can now show that the successor state terms'  s + op 
has the following properties:
\begin{itemize}
  \item terms' v = Some a if term(v, a) exist in term‹set (effect_of op); and,
  \item terms' v = s v if no term(v, a') exist in term‹set (effect_of op).
\end{itemize} 
The second property is the case if the operator doesn't have an effect for a variable termv. ›

theorem execute_operator_sas_plus_effect:
  assumes "is_operator_applicable_in s op"
    and "(v, a)  set (effect_of op). 
      (v', a')  set (effect_of op). v  v'  a = a'"
  shows "(v, a)  set (effect_of op) 
       (s + op) v = Some a"
    and "(a. (v, a)  set (effect_of op)) 
       (s + op) v = s v"
proof -
  show "(v, a)  set (effect_of op) 
     (s + op) v = Some a" 
    using execute_operator_sas_plus_effect_i[OF assms(1, 2)]
    by blast
next 
  show "(a. (v, a)  set (effect_of op)) 
     (s + op) v = s v" 
    using execute_operator_sas_plus_effect_ii[OF assms(1)]
    by blast
qed

end


subsection "Parallel Execution Semantics"

― ‹ Define a type synonym for \emph{SAS+ parallel plans} and add a definition lifting SAS+
operator applicability to parallel plans. ›

type_synonym ('variable, 'domain) sas_plus_parallel_plan 
  = "('variable, 'domain) sas_plus_operator list list" 
    
definition are_all_operators_applicable_in
  :: "('variable, 'domain) state 
     ('variable, 'domain) sas_plus_operator list
     bool"
  where "are_all_operators_applicable_in s ops 
     list_all (is_operator_applicable_in s) ops"

definition are_operator_effects_consistent
  :: "('variable, 'domain) sas_plus_operator
     ('variable, 'domain) sas_plus_operator
     bool"
  where "are_operator_effects_consistent op op' 
     let 
        effect = effect_of op
        ; effect' = effect_of op'
      in list_all (λ(v, a). list_all (λ(v', a'). v  v'  a = a') effect') effect"

definition are_all_operator_effects_consistent
  :: "('variable, 'domain) sas_plus_operator list
     bool"
  where "are_all_operator_effects_consistent ops 
     list_all (λop. list_all (are_operator_effects_consistent op) ops) ops"   

definition execute_parallel_operator_sas_plus
  :: "('variable, 'domain) state 
     ('variable, 'domain) sas_plus_operator list 
     ('variable, 'domain) state"
  where "execute_parallel_operator_sas_plus s ops 
     foldl (++) s (map (map_of  effect_of) ops)" 

text ‹ We now define parallel execution and parallel traces for SAS+ by lifting the tests for 
applicability and effect consistency to parallel SAS+ operators. The definitions are again very
similar to their STRIPS analogs (definitions \ref{isadef:parallel-plan-execution-strips} and 
\ref{isadef:parallel-plan-trace-strips}). ›

fun execute_parallel_plan_sas_plus
  :: "('variable, 'domain) state 
     ('variable, 'domain) sas_plus_parallel_plan
     ('variable, 'domain) state" 
  where "execute_parallel_plan_sas_plus s [] = s"
  | "execute_parallel_plan_sas_plus s (ops # opss) = (if 
      are_all_operators_applicable_in s ops 
       are_all_operator_effects_consistent ops
    then execute_parallel_plan_sas_plus 
      (execute_parallel_operator_sas_plus s ops) opss
    else s)"

fun trace_parallel_plan_sas_plus
  :: "('variable, 'domain) state  
     ('variable, 'domain) sas_plus_parallel_plan 
     ('variable, 'domain) state list"
  where "trace_parallel_plan_sas_plus s [] = [s]"
  | "trace_parallel_plan_sas_plus s (ops # opss) = s # (if 
      are_all_operators_applicable_in s ops 
       are_all_operator_effects_consistent ops
    then trace_parallel_plan_sas_plus 
      (execute_parallel_operator_sas_plus s ops) opss
    else [])"

text ‹ A plan termψ is a solution for a SAS+ problem termΨ if 
\begin{enumerate}
  \item starting from the initial state termΨ, SAS+ parallel plan execution 
    reaches a state which satisfies the described goal state term‹sas_plus_problem.goal_of Ψ; and,
  \item all parallel operators termops in the plan termψ only consist of operators that
    are specified in the problem description.
\end{enumerate} ›
definition is_parallel_solution_for_problem 
  :: "('variable, 'domain) sas_plus_problem 
     ('variable, 'domain) sas_plus_parallel_plan 
     bool"
  where "is_parallel_solution_for_problem Ψ ψ 
     let 
        G = sas_plus_problem.goal_of Ψ
        ; I = sas_plus_problem.initial_of Ψ
        ; Ops = sas_plus_problem.operators_of Ψ
      in G m execute_parallel_plan_sas_plus I ψ
       list_all (λops. list_all (λop. ListMem op Ops) ops) ψ" 

context 
begin

lemma execute_parallel_operator_sas_plus_cons[simp]:
  "execute_parallel_operator_sas_plus s (op # ops)
    = execute_parallel_operator_sas_plus (s ++  map_of (effect_of op)) ops" 
  unfolding execute_parallel_operator_sas_plus_def
  by simp

text ‹The following lemmas show the properties of SAS+ parallel plan execution traces. 
The results are analogous to those for STRIPS. So, let termτ  trace_parallel_plan_sas_plus I ψ 
be a trace of a parallel SAS+ plan termψ with initial state termI, then
\begin{itemize}
  \item the head of the trace termτ ! 0 is the initial state of the 
problem (lemma \ref{isathm:head-parallel-plan-trace-sas-plus}); moreover,
  \item for all but the last element of the trace---i.e. elements with index 
termk < length τ - 1---the parallel operator termπ ! k is executable (lemma 
\ref{isathm:parallel-plan-trace-operator-execution-conditions-sas-plus}); and 
finally, 
  \item for all termk < length τ, the parallel execution of the plan prefix term‹take k ψ with 
initial state termI equals the termk-th element of the trace termτ ! k (lemma 
\ref{isathm:parallel-trace-plan-prefixes-sas-plus}).
\end{itemize} ›

(* TODO? Make invisible? *)
lemma trace_parallel_plan_sas_plus_head_is_initial_state: 
  "trace_parallel_plan_sas_plus I ψ ! 0 = I"
proof (cases ψ)
  case (Cons a list)
  then show ?thesis 
    by (cases "are_all_operators_applicable_in I a  are_all_operator_effects_consistent a"; 
        simp+)
qed simp

lemma trace_parallel_plan_sas_plus_length_gt_one_if:
  assumes "k < length (trace_parallel_plan_sas_plus I ψ) - 1"  
  shows "1 < length (trace_parallel_plan_sas_plus I ψ)" 
  using assms
  by linarith
    
lemma length_trace_parallel_plan_sas_plus_lte_length_plan_plus_one:
  shows "length (trace_parallel_plan_sas_plus I ψ)  length ψ + 1" 
proof (induction ψ arbitrary: I)
  case (Cons a ψ)
  then show ?case 
    proof (cases "are_all_operators_applicable_in I a  are_all_operator_effects_consistent a")
      case True
      let ?I' = "execute_parallel_operator_sas_plus I a" 
      {
        have "trace_parallel_plan_sas_plus I (a # ψ) = I # trace_parallel_plan_sas_plus ?I' ψ" 
          using True
          by auto
        then have "length (trace_parallel_plan_sas_plus I (a # ψ)) 
          = length (trace_parallel_plan_sas_plus ?I' ψ) + 1"
          by simp
        moreover have "length (trace_parallel_plan_sas_plus ?I' ψ)  length ψ + 1"
          using Cons.IH[of ?I']
          by blast
        ultimately have "length (trace_parallel_plan_sas_plus I (a # ψ))  length (a # ψ) + 1"
          by simp
      }
      thus ?thesis
        by blast
    qed auto
qed simp
    
lemma plan_is_at_least_singleton_plan_if_trace_has_at_least_two_elements:
  assumes "k < length (trace_parallel_plan_sas_plus I ψ) - 1" 
  obtains ops ψ' where "ψ = ops # ψ'" 
proof -
  let  = "trace_parallel_plan_sas_plus I ψ"
  have "length   length ψ + 1" 
    using length_trace_parallel_plan_sas_plus_lte_length_plan_plus_one
    by fast
  then have "0 < length ψ"
    using trace_parallel_plan_sas_plus_length_gt_one_if[OF assms]
    by fastforce
  then obtain k' where "length ψ = Suc k'"
    using gr0_implies_Suc
    by meson
  thus ?thesis using that  
    using length_Suc_conv[of ψ k']
    by blast
qed

lemma trace_parallel_plan_sas_plus_step_implies_operator_execution_condition_holds:
  assumes "k < length (trace_parallel_plan_sas_plus I π) - 1"
  shows "are_all_operators_applicable_in (trace_parallel_plan_sas_plus I π ! k) (π ! k)
       are_all_operator_effects_consistent (π ! k)"
using assms 
proof  (induction "π" arbitrary: I k)
  ― ‹ NOTE Base case yields contradiction with assumption and can be left to automation. ›
  case (Cons a π)
  then show ?case 
    proof (cases "are_all_operators_applicable_in I a  are_all_operator_effects_consistent a")
      case True
      have trace_parallel_plan_sas_plus_cons: "trace_parallel_plan_sas_plus I (a # π) 
        = I # trace_parallel_plan_sas_plus (execute_parallel_operator_sas_plus I a) π"
        using True
        by simp  
      then show ?thesis 
      proof (cases "k")
        case 0
        have "trace_parallel_plan_sas_plus I (a # π) ! 0 = I" 
          using trace_parallel_plan_sas_plus_cons
          by simp
        moreover have "(a # π) ! 0 = a"
          by simp
        ultimately show ?thesis 
          using True 0
          by presburger
      next
        case (Suc k')
        have "trace_parallel_plan_sas_plus I (a # π) ! Suc k' 
          = trace_parallel_plan_sas_plus (execute_parallel_operator_sas_plus I a) π ! k'" 
          using trace_parallel_plan_sas_plus_cons
          by simp
        moreover have "(a # π) ! Suc k' = π ! k'"
          by simp
        moreover {
          let ?I' = "execute_parallel_operator_sas_plus I a"
          have "length (trace_parallel_plan_sas_plus I (a # π)) 
            = 1 + length (trace_parallel_plan_sas_plus ?I' π)" 
            using trace_parallel_plan_sas_plus_cons 
            by auto
          then have "k' < length (trace_parallel_plan_sas_plus ?I' π) - 1" 
            using Cons.prems Suc
            unfolding Suc_eq_plus1
            by fastforce
          hence "are_all_operators_applicable_in
            (trace_parallel_plan_sas_plus (execute_parallel_operator_sas_plus I a) π ! k')
            (π ! k') 
           are_all_operator_effects_consistent (π ! k')"
            using Cons.IH[of k' "execute_parallel_operator_sas_plus I a"] Cons.prems Suc trace_parallel_plan_sas_plus_cons
            by simp
        }
        ultimately show ?thesis 
          using Suc
          by argo
      qed 
    next
      case False
      then have "trace_parallel_plan_sas_plus I (a # π) = [I]"
        by force
      then have "length (trace_parallel_plan_sas_plus I (a # π)) - 1 = 0" 
        by simp
      ― ‹ NOTE Thesis follows from contradiction with assumption. ›
      then show ?thesis 
        using Cons.prems
        by force 
    qed
qed auto

lemma trace_parallel_plan_sas_plus_prefix:
  assumes "k < length (trace_parallel_plan_sas_plus I ψ)"
  shows "trace_parallel_plan_sas_plus I ψ ! k = execute_parallel_plan_sas_plus I (take k ψ)" 
  using assms
proof  (induction ψ arbitrary: I k)
  case (Cons a ψ)
  then show ?case 
    proof (cases "are_all_operators_applicable_in I a  are_all_operator_effects_consistent a")
      case True
      let  = "trace_parallel_plan_sas_plus I (a # ψ)"
        and ?I' = "execute_parallel_operator_sas_plus I a" 
      have σ_equals: " = I # trace_parallel_plan_sas_plus ?I' ψ" 
        using True
        by auto
      then show ?thesis 
        proof (cases "k = 0")
          case False
          obtain k' where k_is_suc_of_k': "k = Suc k'" 
            using not0_implies_Suc[OF False]
            by blast
          then have "execute_parallel_plan_sas_plus I (take k (a # ψ))
            = execute_parallel_plan_sas_plus ?I' (take k' ψ)" 
            using True
            by simp
          moreover have "trace_parallel_plan_sas_plus I (a # ψ) ! k 
            = trace_parallel_plan_sas_plus ?I' ψ ! k'" 
            using σ_equals k_is_suc_of_k'
            by simp
          moreover {
            have "k' < length (trace_parallel_plan_sas_plus ?I' ψ)"
              using Cons.prems σ_equals k_is_suc_of_k'
              by force
            hence "trace_parallel_plan_sas_plus ?I' ψ ! k' 
              = execute_parallel_plan_sas_plus ?I' (take k' ψ)" 
              using Cons.IH[of k' ?I']
              by blast
          }
          ultimately show ?thesis
            by presburger
        qed simp
    next
      case operator_precondition_violated: False
      then show ?thesis 
      proof (cases "k = 0")
        case False
        then have "trace_parallel_plan_sas_plus I (a # ψ) = [I]"
          using operator_precondition_violated
          by force
        moreover have "execute_parallel_plan_sas_plus I (take k (a # ψ)) = I" 
          using Cons.prems operator_precondition_violated 
          by force
        ultimately show ?thesis 
          using Cons.prems nth_Cons_0
          by auto
      qed simp
    qed
qed simp

lemma trace_parallel_plan_sas_plus_step_effect_is:
  assumes "k < length (trace_parallel_plan_sas_plus I ψ) - 1"
  shows "trace_parallel_plan_sas_plus I ψ ! Suc k 
    = execute_parallel_operator_sas_plus (trace_parallel_plan_sas_plus I ψ ! k) (ψ ! k)" 
proof -
  let  = "trace_parallel_plan_sas_plus I ψ"
  let k = " ! k"
    and k' = " ! Suc k"
  ― ‹ NOTE rewrite the goal using the subplan formulation to be able. This allows us to make the 
    initial state arbitrary. ›
  {
    have suc_k_lt_length_τ: "Suc k < length " 
      using assms 
      by linarith
    hence "k' = execute_parallel_plan_sas_plus I (take (Suc k) ψ)"
      using trace_parallel_plan_sas_plus_prefix[of "Suc k"]
      by blast
  } note rewrite_goal = this
  have "execute_parallel_plan_sas_plus I (take (Suc k) ψ) 
    = execute_parallel_operator_sas_plus (trace_parallel_plan_sas_plus I ψ ! k) (ψ ! k)" 
    using assms
    proof (induction k arbitrary: I ψ)
      case 0
      obtain ops ψ' where ψ_is: "ψ = ops # ψ'" 
        using plan_is_at_least_singleton_plan_if_trace_has_at_least_two_elements[OF "0.prems"] 
        by force
      {
        have "take (Suc 0) ψ  = [ψ ! 0]" 
          using ψ_is
          by simp
        hence "execute_parallel_plan_sas_plus I (take (Suc 0) ψ) 
          = execute_parallel_plan_sas_plus I [ψ ! 0]"
          by argo
      }
      moreover {
        have "trace_parallel_plan_sas_plus I ψ ! 0 = I" 
          using trace_parallel_plan_sas_plus_head_is_initial_state.
        moreover {
          have "are_all_operators_applicable_in I (ψ ! 0)" 
            and "are_all_operator_effects_consistent (ψ ! 0)" 
            using trace_parallel_plan_sas_plus_step_implies_operator_execution_condition_holds[OF
                "0.prems"] calculation 
            by argo+
          then have "execute_parallel_plan_sas_plus I [ψ ! 0] 
            = execute_parallel_operator_sas_plus I (ψ ! 0)"
            by simp
        }
        ultimately have "execute_parallel_operator_sas_plus (trace_parallel_plan_sas_plus I ψ ! 0) 
            (ψ ! 0)
          = execute_parallel_plan_sas_plus I [ψ ! 0]"
          by argo
      }
      ultimately show ?case 
        by argo
    next
      case (Suc k)
      obtain ops ψ' where ψ_is: "ψ = ops # ψ'" 
        using plan_is_at_least_singleton_plan_if_trace_has_at_least_two_elements[OF Suc.prems]
        by blast
      let ?I' = "execute_parallel_operator_sas_plus I ops"
      have "execute_parallel_plan_sas_plus I (take (Suc (Suc k)) ψ)
        = execute_parallel_plan_sas_plus ?I' (take (Suc k) ψ')" 
        using Suc.prems ψ_is
        by fastforce
      moreover {
        thm Suc.IH[of ]
        have "length (trace_parallel_plan_sas_plus I ψ)
          = 1 + length (trace_parallel_plan_sas_plus ?I' ψ')" 
          using ψ_is Suc.prems
          by fastforce
        moreover have "k < length (trace_parallel_plan_sas_plus ?I' ψ') - 1"
          using Suc.prems calculation
          by fastforce
        ultimately have "execute_parallel_plan_sas_plus ?I' (take (Suc k) ψ') =
          execute_parallel_operator_sas_plus (trace_parallel_plan_sas_plus ?I' ψ' ! k) 
          (ψ' ! k)"
          using Suc.IH[of ?I' ψ']
          by blast          
      }
      moreover have "execute_parallel_operator_sas_plus (trace_parallel_plan_sas_plus ?I' ψ' ! k) 
          (ψ' ! k)
        = execute_parallel_operator_sas_plus (trace_parallel_plan_sas_plus I ψ ! Suc k)
          (ψ ! Suc k)" 
        using Suc.prems ψ_is
        by auto
      ultimately show ?case
        by argo 
    qed 
  thus ?thesis 
    using rewrite_goal
    by argo
qed

text ‹ Finally, we obtain the result corresponding to lemma 
\ref{isathm:parallel-solution-trace-strips} in the SAS+ case: it is equivalent to say that parallel 
SAS+ execution reaches the problem's goal state and that the last element of the corresponding 
trace satisfies the goal state. ›
lemma  execute_parallel_plan_sas_plus_reaches_goal_iff_goal_is_last_element_of_trace:
  "G m execute_parallel_plan_sas_plus I ψ 
     G m last (trace_parallel_plan_sas_plus I ψ)" 
proof   -
  let  = "trace_parallel_plan_sas_plus I ψ" 
  show ?thesis 
  proof (rule iffI)
    assume "G m execute_parallel_plan_sas_plus I ψ"
    thus "G m last " 
      proof (induction ψ arbitrary: I)
        ― ‹ NOTE Base case follows from simplification. ›
        case (Cons ops ψ)
        show ?case
          proof (cases "are_all_operators_applicable_in I ops 
             are_all_operator_effects_consistent ops")
            case True
            let ?s = "execute_parallel_operator_sas_plus I ops"
            {
              have "G m execute_parallel_plan_sas_plus ?s ψ"
                using True Cons.prems
                by simp
              hence "G m last (trace_parallel_plan_sas_plus ?s ψ)" 
                using Cons.IH
                by auto
            }
            moreover {
              have "trace_parallel_plan_sas_plus I (ops # ψ) 
                = I # trace_parallel_plan_sas_plus ?s ψ" 
                using True 
                by simp
              moreover have "trace_parallel_plan_sas_plus ?s ψ  []" 
                using trace_parallel_plan_sas_plus.elims
                by blast 
              ultimately have "last (trace_parallel_plan_sas_plus I (ops # ψ)) 
                = last (trace_parallel_plan_sas_plus ?s ψ)" 
                using last_ConsR
                  by simp
            }
            ultimately show ?thesis 
              by argo
          next
            case False
            then have "G m I"
              using Cons.prems 
              by force
            thus ?thesis
              using False
              by force
          qed
      qed force
  next 
    assume "G m last "
    thus "G m execute_parallel_plan_sas_plus I ψ" 
      proof (induction ψ arbitrary: I)
        case (Cons ops ψ)
        thus ?case
          proof (cases "are_all_operators_applicable_in I ops
             are_all_operator_effects_consistent ops")
            case True
            let ?s = "execute_parallel_operator_sas_plus I ops"
            {
              have "trace_parallel_plan_sas_plus I (ops # ψ) 
                = I # trace_parallel_plan_sas_plus ?s ψ" 
                using True 
                by simp
              moreover have "trace_parallel_plan_sas_plus ?s ψ  []" 
                using trace_parallel_plan_sas_plus.elims
                by blast 
              ultimately have "last (trace_parallel_plan_sas_plus I (ops # ψ)) 
                = last (trace_parallel_plan_sas_plus ?s ψ)" 
                using last_ConsR
                by simp
              hence "G m execute_parallel_plan_sas_plus ?s ψ"
                using Cons.IH[of ?s] Cons.prems 
                by argo
            }
            moreover have "execute_parallel_plan_sas_plus I (ops # ψ) 
                = execute_parallel_plan_sas_plus ?s ψ" 
              using True
              by force
            ultimately show ?thesis 
              by argo
          next
            case False
            have "G m I"
              using Cons.prems False 
              by simp
            thus ?thesis
              using False
              by force
          qed
      qed simp
  qed
qed

lemma is_parallel_solution_for_problem_plan_operator_set:
  (* TODO refactor move + make visible? *)
  fixes Ψ :: "('v, 'd) sas_plus_problem"
  assumes "is_parallel_solution_for_problem Ψ ψ" 
  shows "ops  set ψ. op  set ops. op  set ((Ψ)𝒪+)"
  using assms
  unfolding is_parallel_solution_for_problem_def list_all_iff ListMem_iff operators_of_def 
  by presburger

end


subsection "Serializable Parallel Plans"

text ‹ Again we want to establish conditions for the serializability of plans. Let
termΨ be a SAS+ problem instance and let termψ be a serial solution. We obtain the following 
two important results, namely that
\begin{enumerate}
  \item the embedding term‹embed ψ of termψ is a parallel solution for termΨ 
(lemma \ref{isathm:serial-sas-plus-embedding}); and conversely that,
  \item a parallel solution to termΨ that has the form of an embedded serial plan can be 
concatenated to obtain a serial solution (lemma 
\ref{isathm:embedded-serial-solution-flattening-sas-plus}).
\end{enumerate} ›


context
begin

(* TODO refactor *)
lemma execute_serial_plan_sas_plus_is_execute_parallel_plan_sas_plus_i:
  assumes "is_operator_applicable_in s op"
    "are_operator_effects_consistent op op" 
  shows "s + op = execute_parallel_operator_sas_plus s [op]"
proof -
  have "are_all_operators_applicable_in s [op]"
    unfolding are_all_operators_applicable_in_def 
       SAS_Plus_Representation.execute_operator_sas_plus_def
      is_operator_applicable_in_def SAS_Plus_Representation.is_operator_applicable_in_def
      list_all_iff  
    using assms(1) 
    by fastforce
  moreover have "are_all_operator_effects_consistent [op]"
    unfolding are_all_operator_effects_consistent_def list_all_iff
    using assms(2)
    by fastforce
  ultimately show ?thesis
    unfolding execute_parallel_operator_sas_plus_def execute_operator_sas_plus_def
    by simp
qed

lemma execute_serial_plan_sas_plus_is_execute_parallel_plan_sas_plus_ii:
  fixes I :: "('variable, 'domain) state"
  assumes "op  set ψ. are_operator_effects_consistent op op"
    and "G m execute_serial_plan_sas_plus I ψ" 
  shows "G m execute_parallel_plan_sas_plus I (embed ψ)" 
  using assms
proof (induction ψ arbitrary: I)
  case (Cons op ψ)
  show ?case 
    proof (cases "are_all_operators_applicable_in I [op]")
      case True
      let ?J = "execute_operator_sas_plus I op" 
        let ?J' = "execute_parallel_operator_sas_plus I [op]" 
      have "SAS_Plus_Representation.is_operator_applicable_in I op"
        using True 
        unfolding are_all_operators_applicable_in_def list_all_iff
        by force
      moreover have "G m execute_serial_plan_sas_plus ?J ψ" 
        using Cons.prems(2) calculation(1) 
        by simp
      moreover have "are_all_operator_effects_consistent [op]" 
        unfolding are_all_operator_effects_consistent_def list_all_iff Let_def
        using Cons.prems(1)
        by simp
      moreover have "execute_parallel_plan_sas_plus I ([op] # embed ψ) 
        = execute_parallel_plan_sas_plus ?J' (embed ψ)"
        using True calculation(3) 
        by simp
      moreover {
        have "is_operator_applicable_in I op" 
          "are_operator_effects_consistent op op" 
          using True Cons.prems(1)
          unfolding are_all_operators_applicable_in_def 
            SAS_Plus_Representation.is_operator_applicable_in_def list_all_iff 
          by fastforce+
        hence "?J = ?J'" 
          using execute_serial_plan_sas_plus_is_execute_parallel_plan_sas_plus_i
            calculation(1) 
          by blast
      }
      ultimately show ?thesis 
        using Cons.IH[of ?J] Cons.prems(1)
        by simp
    next
      case False
      moreover have "¬is_operator_applicable_in I op" 
        using calculation 
        unfolding are_all_operators_applicable_in_def 
          SAS_Plus_Representation.is_operator_applicable_in_def list_all_iff 
        by fastforce
      moreover have "G m I" 
        using Cons.prems(2) calculation(2)
        unfolding is_operator_applicable_in_def
        by simp
      moreover have "execute_parallel_plan_sas_plus I ([op] # embed ψ) = I" 
        using calculation(1)
        by fastforce
      ultimately show ?thesis
        by force
    qed
  qed simp

lemma execute_serial_plan_sas_plus_is_execute_parallel_plan_sas_plus_iii:
  assumes "is_valid_problem_sas_plus Ψ" 
    and "is_serial_solution_for_problem Ψ ψ"
    and "op  set ψ"
  shows "are_operator_effects_consistent op op"
proof -
  have "op  set ((Ψ)𝒪+)"
    using assms(2) assms(3)
    unfolding is_serial_solution_for_problem_def Let_def list_all_iff ListMem_iff 
    by fastforce
  then have "is_valid_operator_sas_plus Ψ op" 
    using is_valid_problem_sas_plus_then(2) assms(1, 3) 
    by auto
  thus ?thesis
    unfolding are_operator_effects_consistent_def Let_def list_all_iff ListMem_iff
    using is_valid_operator_sas_plus_then(6)
    by fast
qed

lemma execute_serial_plan_sas_plus_is_execute_parallel_plan_sas_plus_iv:
  fixes Ψ :: "('v, 'd) sas_plus_problem"
  assumes "op  set ψ. op  set ((Ψ)𝒪+)"
  shows "ops  set (embed ψ). op  set ops. op  set ((Ψ)𝒪+)"
proof -
  let ?ψ' = "embed ψ"
  have nb: "set ?ψ' = { [op] | op. op  set ψ }" 
    by (induction ψ; force)
  {
    fix ops
    assume "ops  set ?ψ'"
    moreover obtain op where "ops = [op]" and "op  set ((Ψ)𝒪+)"
      using assms(1) nb calculation 
      by blast
    ultimately have "op  set ops. op  set ((Ψ)𝒪+)"
      by fastforce
  }
  thus ?thesis..
qed

theorem execute_serial_plan_sas_plus_is_execute_parallel_plan_sas_plus:
  assumes "is_valid_problem_sas_plus Ψ" 
    and "is_serial_solution_for_problem Ψ ψ" 
  shows "is_parallel_solution_for_problem Ψ (embed ψ)" 
proof  -
  let ?ops = "sas_plus_problem.operators_of Ψ" 
    and ?ψ' = "embed ψ" 
  {
    thm execute_serial_plan_sas_plus_is_execute_parallel_plan_sas_plus_ii[OF]
    have "(Ψ)G+ m execute_serial_plan_sas_plus ((Ψ)I+) ψ"
      using assms(2) 
      unfolding is_serial_solution_for_problem_def Let_def
      by simp
    moreover have "op  set ψ. are_operator_effects_consistent op op" 
      using execute_serial_plan_sas_plus_is_execute_parallel_plan_sas_plus_iii[OF assms]..
    ultimately have "(Ψ)G+ m execute_parallel_plan_sas_plus ((Ψ)I+) ?ψ'" 
      using execute_serial_plan_sas_plus_is_execute_parallel_plan_sas_plus_ii
      by blast
  }
  moreover {
    have "op  set ψ. op  set ((Ψ)𝒪+)"
      using assms(2) 
      unfolding is_serial_solution_for_problem_def Let_def list_all_iff ListMem_iff
      by fastforce
    hence "ops  set ?ψ'. op  set ops. op  set ((Ψ)𝒪+)" 
      using execute_serial_plan_sas_plus_is_execute_parallel_plan_sas_plus_iv
      by blast
  }
  ultimately show ?thesis
    unfolding is_parallel_solution_for_problem_def list_all_iff ListMem_iff Let_def goal_of_def 
      initial_of_def
    by fastforce
qed

lemma flattening_lemma_i:
  fixes Ψ :: "('v, 'd) sas_plus_problem"
  assumes "ops  set π. op  set ops. op  set ((Ψ)𝒪+)"
  shows "op  set (concat π). op  set ((Ψ)𝒪+)"
proof -
  {
    fix op
    assume "op  set (concat π)" 
    moreover have "op  (ops  set π. set ops)" 
      using calculation
      unfolding set_concat.
    then obtain ops where "ops  set π" and "op  set ops" 
      using UN_iff
      by blast
    ultimately have "op  set ((Ψ)𝒪+)" 
      using assms
      by blast
  }
  thus ?thesis..
qed

lemma flattening_lemma_ii:
  fixes I :: "('variable, 'domain) state"
  assumes "ops  set ψ. op. ops = [op]  is_valid_operator_sas_plus Ψ op " 
    and "G m execute_parallel_plan_sas_plus I ψ" 
  shows "G m execute_serial_plan_sas_plus I (concat ψ)"
proof -
  show ?thesis 
    using assms
    proof (induction ψ arbitrary: I)
      case (Cons ops ψ)
      obtain op where ops_is: "ops = [op]" and is_valid_op: "is_valid_operator_sas_plus Ψ op" 
        using Cons.prems(1)
        by auto
      then show ?case 
        proof (cases "are_all_operators_applicable_in I ops")
          case True
          let ?J = "execute_parallel_operator_sas_plus I [op]" 
            and ?J' = "execute_operator_sas_plus I op" 
          have nb1: "is_operator_applicable_in I op" 
            using True ops_is
            unfolding are_all_operators_applicable_in_def is_operator_applicable_in_def 
              list_all_iff 
            by force
          have nb2: "are_operator_effects_consistent op op" 
            unfolding are_operator_effects_consistent_def list_all_iff Let_def 
            using is_valid_operator_sas_plus_then(6)[OF is_valid_op]
            by blast
          have "are_all_operator_effects_consistent ops" 
            using ops_is 
            unfolding are_all_operator_effects_consistent_def list_all_iff
            using nb2
            by force
          moreover have "G m execute_parallel_plan_sas_plus ?J ψ"
            using Cons.prems(2) True calculation ops_is
            by fastforce
          moreover have "execute_serial_plan_sas_plus I (concat (ops # ψ)) 
              = execute_serial_plan_sas_plus ?J' (concat ψ)"
              using ops_is nb1 is_operator_applicable_in_def
              by simp
          moreover have "?J = ?J'" 
            using execute_serial_plan_sas_plus_is_execute_parallel_plan_sas_plus_i[OF nb1 nb2]
            by simp
          ultimately show ?thesis
            using Cons.IH[of ?J] Cons.prems(1)
            by force
        next
          case False
          moreover have "G m I" 
            using Cons.prems(2) calculation
            by fastforce
          moreover {
            have "¬is_operator_applicable_in I op" 
              using False ops_is
              unfolding are_all_operators_applicable_in_def 
                is_operator_applicable_in_def list_all_iff
              by force
            moreover have "execute_serial_plan_sas_plus I (concat (ops # ψ)) 
              = execute_serial_plan_sas_plus I (op # concat ψ)" 
              using ops_is 
              by force
            ultimately have "execute_serial_plan_sas_plus I (concat (ops # ψ)) = I"
              using False 
              unfolding is_operator_applicable_in_def
              by fastforce
          }
          ultimately show ?thesis
            by argo
        qed  
    qed force
qed

lemma flattening_lemma:
  assumes "is_valid_problem_sas_plus Ψ"
    and "ops  set ψ. op. ops = [op]" 
    and "is_parallel_solution_for_problem Ψ ψ"
  shows "is_serial_solution_for_problem Ψ (concat ψ)"
proof  -
  let ?ψ' = "concat ψ" 
  {
    have "ops  set ψ. op  set ops. op  set ((Ψ)𝒪+)" 
      using assms(3)
      unfolding is_parallel_solution_for_problem_def list_all_iff ListMem_iff
      by force
    hence "op  set ?ψ'. op  set ((Ψ)𝒪+)"
      using flattening_lemma_i
      by blast
  }
  moreover {
    {
      fix ops
      assume "ops  set ψ" 
      moreover obtain op where "ops = [op]" 
        using assms(2) calculation
        by blast
      moreover have "op  set ((Ψ)𝒪+)" 
        using assms(3) calculation
        unfolding is_parallel_solution_for_problem_def list_all_iff ListMem_iff 
        by force
      moreover have "is_valid_operator_sas_plus Ψ op" 
        using assms(1) calculation(3)
        unfolding is_valid_problem_sas_plus_def Let_def list_all_iff 
          ListMem_iff
        by simp
      ultimately have "op. ops = [op]  is_valid_operator_sas_plus Ψ op"
        by blast
    }
    moreover have "(Ψ)G+ m execute_parallel_plan_sas_plus ((Ψ)I+) ψ" 
      using assms(3) 
      unfolding is_parallel_solution_for_problem_def
      by fastforce
    ultimately have "(Ψ)G+ m execute_serial_plan_sas_plus ((Ψ)I+) ?ψ'" 
      using flattening_lemma_ii
      by blast
  }
  ultimately show "is_serial_solution_for_problem Ψ ?ψ'" 
    unfolding is_serial_solution_for_problem_def list_all_iff ListMem_iff
    by fastforce
qed
end

subsection "Auxiliary lemmata on SAS+"


context
begin

― ‹ Relate the locale definition range_of› with its corresponding implementation for valid 
operators and given an effect (v, a)›. ›
lemma is_valid_operator_sas_plus_then_range_of_sas_plus_op_is_set_range_of_op:
  assumes "is_valid_operator_sas_plus Ψ op"
    and "(v, a)  set (precondition_of op)  (v, a)  set (effect_of op)"
  shows "(+ Ψ v) = set (the (sas_plus_problem.range_of Ψ v))" 
proof -
  consider (A) "(v, a)  set (precondition_of op)"
    | (B)  "(v, a)  set (effect_of op)"
    using assms(2)..
  thus ?thesis 
    proof (cases)
      case A
      then have "(+ Ψ v)  {}" and "a  + Ψ v" 
        using assms 
        unfolding range_of_def
        using is_valid_operator_sas_plus_then(2)
        by fast+
      thus ?thesis
        unfolding range_of'_def option.case_eq_if
        by auto
    next
      case B
      then have "(+ Ψ v)  {}" and "a  + Ψ v" 
        using assms 
        unfolding range_of_def
        using is_valid_operator_sas_plus_then(4)
        by fast+
      thus ?thesis
        unfolding range_of'_def option.case_eq_if
        by auto
    qed  
qed 

lemma set_the_range_of_is_range_of_sas_plus_if:
  fixes Ψ :: "('v, 'd) sas_plus_problem"
  assumes "is_valid_problem_sas_plus Ψ"
    "v  set ((Ψ)𝒱+)"
  shows "set (the (sas_plus_problem.range_of Ψ v)) = + Ψ v"
proof-
  have "v  set((Ψ)𝒱+)" 
    using assms(2)
    unfolding variables_of_def.
  moreover have "(+ Ψ v)  {}"
    using assms(1) calculation is_valid_problem_sas_plus_then(1)
    by blast
  moreover have "sas_plus_problem.range_of Ψ v  None" 
    and "sas_plus_problem.range_of Ψ v  Some []"
    using calculation(2) range_of_not_empty
    unfolding range_of_def 
    by fast+
  ultimately show ?thesis
    unfolding option.case_eq_if range_of'_def
    by force
qed

lemma sublocale_sas_plus_finite_domain_representation_ii:
  fixes Ψ::"('v,'d) sas_plus_problem"
  assumes "is_valid_problem_sas_plus Ψ"
  shows "v  set ((Ψ)𝒱+). (+ Ψ v)  {}"
    and "op  set ((Ψ)𝒪+). is_valid_operator_sas_plus Ψ op"
    and "dom ((Ψ)I+) = set ((Ψ)𝒱+)"
    and "v  dom ((Ψ)I+). the (((Ψ)I+) v)  + Ψ v"
    and "dom ((Ψ)G+)  set ((Ψ)𝒱+)"
    and "v  dom ((Ψ)G+). the (((Ψ)G+) v)  + Ψ v"
  using is_valid_problem_sas_plus_then[OF assms]
  by auto

end

end

Theory SAS_Plus_STRIPS

(*
  Author: Mohammad Abdulaziz, Fred Kurz
*)
theory SAS_Plus_STRIPS
  imports "STRIPS_Semantics" "SAS_Plus_Semantics" 
    "Map_Supplement"
begin

section "SAS+/STRIPS Equivalence"

text ‹ The following part is concerned with showing the equivalent expressiveness of SAS+ and
STRIPS as discussed in \autoref{sub:equivalence-sas-plus-strips}. ›

subsection "Translation of SAS+ Problems to STRIPS Problems"

definition possible_assignments_for 
  :: "('variable, 'domain) sas_plus_problem  'variable  ('variable × 'domain) list" 
  where "possible_assignments_for Ψ v  [(v, a). a  the (range_of Ψ v)]"

definition all_possible_assignments_for
  :: "('variable, 'domain) sas_plus_problem  ('variable × 'domain) list"
  where "all_possible_assignments_for Ψ 
     concat [possible_assignments_for Ψ v. v  variables_of Ψ]" 

definition state_to_strips_state
  :: "('variable, 'domain) sas_plus_problem 
     ('variable, 'domain) state 
     ('variable, 'domain) assignment strips_state" 
  ("φS _ _" 99)
  where "state_to_strips_state Ψ s 
     let defined = filter (λv. s v  None) (variables_of Ψ) in
      map_of (map (λ(v, a). ((v, a), the (s v) = a)) 
        (concat [possible_assignments_for Ψ v. v  defined]))"

definition sasp_op_to_strips
  :: "('variable, 'domain) sas_plus_problem
     ('variable, 'domain) sas_plus_operator
     ('variable, 'domain) assignment strips_operator" 
  ("φO _ _" 99)
  where "sasp_op_to_strips Ψ op  let
      pre = precondition_of op
      ; add = effect_of op
      ; delete = [(v, a'). (v, a)  effect_of op, a'  filter ((≠) a) (the (range_of Ψ v))]
    in STRIPS_Representation.operator_for pre add delete"

definition sas_plus_problem_to_strips_problem
  :: "('variable, 'domain) sas_plus_problem  ('variable, 'domain) assignment strips_problem" 
  ("φ _ " 99)
  where "sas_plus_problem_to_strips_problem Ψ  let 
      vs = [as. v  variables_of Ψ, as  (possible_assignments_for Ψ) v]
      ; ops = map (sasp_op_to_strips Ψ) (operators_of Ψ)
      ; I = state_to_strips_state Ψ (initial_of Ψ)
      ; G = state_to_strips_state Ψ (goal_of Ψ)
    in STRIPS_Representation.problem_for vs ops I G"

definition sas_plus_parallel_plan_to_strips_parallel_plan
  :: "('variable, 'domain) sas_plus_problem
     ('variable, 'domain) sas_plus_parallel_plan
     ('variable × 'domain) strips_parallel_plan" 
  ("φP _ _" 99)
  where "sas_plus_parallel_plan_to_strips_parallel_plan Ψ ψ
     [[sasp_op_to_strips Ψ op. op  ops]. ops  ψ]"

(* TODO first argument should be ('variable, 'domain) strips_problem *)
definition strips_state_to_state
  :: "('variable, 'domain) sas_plus_problem
     ('variable, 'domain) assignment strips_state
     ('variable, 'domain) state" 
  ("φS¯ _ _" 99)
  where "strips_state_to_state Ψ s 
     map_of (filter (λ(v, a). s (v, a) = Some True) (all_possible_assignments_for Ψ))"

(* TODO remove problem argument *)
definition strips_op_to_sasp 
  :: "('variable, 'domain) sas_plus_problem 
     ('variable × 'domain) strips_operator
     ('variable, 'domain) sas_plus_operator"
  ("φO¯ _ _" 99)
  where "strips_op_to_sasp Ψ op 
     let 
        precondition = strips_operator.precondition_of op
        ; effect = strips_operator.add_effects_of op 
      in  precondition_of = precondition, effect_of = effect " 

(* TODO ‹strips_parallel_plan_to_sas_plus_parallel_plan ↝ φ_P¯› and 
‹strips_op_to_sasp ↝ φ_O¯› *)
definition strips_parallel_plan_to_sas_plus_parallel_plan
  :: "('variable, 'domain) sas_plus_problem
     ('variable × 'domain) strips_parallel_plan
     ('variable, 'domain) sas_plus_parallel_plan" 
  ("φP¯ _ _" 99)
  where "strips_parallel_plan_to_sas_plus_parallel_plan Π π
     [[strips_op_to_sasp Π op. op  ops]. ops  π]"

text ‹ To set up the equivalence proof context, we declare a common locale 
\isaname{sas_plus_strips_equivalence} for both the STRIPS and SAS+ formalisms and make it a 
sublocale of both locale \isaname{strips} as well as \isaname{sas_plus}.
The declaration itself is omitted for brevity since it basically just joins locales 
\isaname{sas_plus} and \isaname{strips} while renaming the locale parameter to avoid name clashes.
The sublocale proofs are shown below.
\footnote{We append a suffix identifying the respective formalism to the the parameter names 
passed to the parameter names in the locale. This is necessary to avoid ambiguous names in the 
sublocale declarations. For example, without addition of suffixes the type for initial_of› is 
ambiguous and will therefore not be bound to either strips_problem.initial_of› or 
sas_plus_problem.initial_of›. 
Isabelle in fact considers it to be a a free variable in this case. We also qualify the parent 
locales in the sublocale declarations by adding \texttt{strips:} and \texttt{sas\_plus:} before 
the respective parent locale identifiers. } ›

definition "range_of_strips Π x  { True, False }"

context
begin

― ‹ Set-up simp rules. ›
lemma[simp]: 
  "(φ Ψ) = (let 
      vs = [as. v  variables_of Ψ, as  (possible_assignments_for Ψ) v]
      ; ops = map (sasp_op_to_strips Ψ) (operators_of Ψ)
      ; I = state_to_strips_state Ψ (initial_of Ψ)
      ; G = state_to_strips_state Ψ (goal_of Ψ)
    in STRIPS_Representation.problem_for vs ops I G)"
  and "(φS Ψ s)
    = (let defined = filter (λv. s v  None) (variables_of Ψ) in
      map_of (map (λ(v, a). ((v, a), the (s v) = a)) 
        (concat [possible_assignments_for Ψ v. v  defined])))"
  and "(φO Ψ op)
    = (let
      pre = precondition_of op
      ; add = effect_of op
      ; delete = [(v, a'). (v, a)  effect_of op, a'  filter ((≠) a) (the (range_of Ψ v))]
    in STRIPS_Representation.operator_for pre add delete)" 
  and "(φP Ψ ψ) = [[φO Ψ op. op  ops]. ops  ψ]"
  and "(φS¯ Ψ s')= map_of (filter (λ(v, a). s' (v, a) = Some True) 
    (all_possible_assignments_for Ψ))" 
  and "(φO¯ Ψ op') = (let 
        precondition = strips_operator.precondition_of op'
        ; effect = strips_operator.add_effects_of op' 
      in  precondition_of = precondition, effect_of = effect )" 
  and "(φP¯ Ψ π) = [[φO¯ Ψ op. op  ops]. ops  π]"
  unfolding
    SAS_Plus_STRIPS.sas_plus_problem_to_strips_problem_def
    sas_plus_problem_to_strips_problem_def
    SAS_Plus_STRIPS.state_to_strips_state_def
    state_to_strips_state_def
    SAS_Plus_STRIPS.sasp_op_to_strips_def
    sasp_op_to_strips_def
    SAS_Plus_STRIPS.sas_plus_parallel_plan_to_strips_parallel_plan_def
    sas_plus_parallel_plan_to_strips_parallel_plan_def
    SAS_Plus_STRIPS.strips_state_to_state_def
    strips_state_to_state_def 
    SAS_Plus_STRIPS.strips_op_to_sasp_def
    strips_op_to_sasp_def 
    SAS_Plus_STRIPS.strips_parallel_plan_to_sas_plus_parallel_plan_def
    strips_parallel_plan_to_sas_plus_parallel_plan_def 
  by blast+

lemmas [simp] = range_of'_def

lemma is_valid_problem_sas_plus_dom_sas_plus_problem_range_of:
  assumes "is_valid_problem_sas_plus Ψ" 
  shows "v  set ((Ψ)𝒱+). v  dom (sas_plus_problem.range_of Ψ)"
  using assms(1) is_valid_problem_sas_plus_then(1)
  unfolding is_valid_problem_sas_plus_def
  by (meson domIff list.pred_set)

lemma possible_assignments_for_set_is:
  assumes "v  dom (sas_plus_problem.range_of Ψ)"
  shows "set (possible_assignments_for Ψ v) 
    = { (v, a) | a. a  + Ψ v }" 
proof -
  have "sas_plus_problem.range_of Ψ v  None"
    using assms(1) 
    by auto
  thus  ?thesis 
    unfolding possible_assignments_for_def
    by fastforce
qed

lemma all_possible_assignments_for_set_is:
  assumes "v  set ((Ψ)𝒱+). range_of Ψ v  None" 
  shows "set (all_possible_assignments_for Ψ)
    = (v  set ((Ψ)𝒱+). { (v, a) | a. a  + Ψ v })" 
proof -
  let ?vs = "variables_of Ψ"
  have "set (all_possible_assignments_for Ψ) = 
    ((set ` (λv. map (λ(v, a). (v, a)) (possible_assignments_for Ψ v)) ` set ?vs))"
    unfolding all_possible_assignments_for_def set_concat
    using set_map 
    by auto
  also have " = (((λv. set (possible_assignments_for Ψ v)) ` set ?vs))"
    using image_comp set_map
    by simp
  (* TODO slow *)
  also have " = (((λv. { (v, a) | a. a  + Ψ v }) ` set ?vs))"
    using possible_assignments_for_set_is assms 
    by fastforce
  finally show ?thesis
    by force
qed

lemma state_to_strips_state_dom_is_i[simp]:
  assumes "v  set ((Ψ)𝒱+). v  dom (sas_plus_problem.range_of Ψ)"
  shows "set (concat 
      [possible_assignments_for Ψ v. v  filter (λv. s v  None) (variables_of Ψ)])
    = (v  { v | v. v  set ((Ψ)𝒱+)  s v  None }. 
      { (v, a) | a. a  + Ψ v })" 
proof -
  let ?vs = "variables_of Ψ"
  let ?defined = "filter (λv. s v  None) ?vs"
  let ?l = "concat [possible_assignments_for Ψ v. v  ?defined]"
  have nb: "set ?defined = { v | v. v  set ((Ψ)𝒱+)  s v  None }" 
    unfolding set_filter
    by force
  have "set ?l = (set ` set (map (possible_assignments_for Ψ) ?defined ))" 
    unfolding set_concat image_Union
    by blast
  also have " = (set ` (possible_assignments_for Ψ) ` set ?defined)" 
    unfolding set_map
    by blast
  also have " = (v  set ?defined. set (possible_assignments_for Ψ v))"
    by blast
  also have " = (v  { v | v. v  set ((Ψ)𝒱+)  s v  None }.
    set (possible_assignments_for Ψ v))"
    using nb 
    by argo
  finally show ?thesis
    using possible_assignments_for_set_is 
      is_valid_problem_sas_plus_dom_sas_plus_problem_range_of assms(1)
    by fastforce
qed

lemma state_to_strips_state_dom_is:
  ― ‹ NOTE A transformed state is defined on all possible assignments for all variables defined 
in the original state. ›
  assumes "is_valid_problem_sas_plus Ψ"
  shows "dom (φS Ψ s) 
    = (v  { v | v. v  set ((Ψ)𝒱+)  s v  None }. 
      { (v, a) | a. a  + Ψ v })"
proof -
  let ?vs = "variables_of Ψ"
  let ?l = "concat [possible_assignments_for Ψ v. v  filter (λv. s v  None) ?vs]"
  have nb: "v  set ((Ψ)𝒱+). v  dom (sas_plus_problem.range_of Ψ)"
    using is_valid_problem_sas_plus_dom_sas_plus_problem_range_of assms(1)
    by fastforce
  have "dom (φS Ψ s) = fst ` set (map (λ(v, a). ((v, a), the (s v) = a)) ?l)" 
    unfolding state_to_strips_state_def 
      SAS_Plus_STRIPS.state_to_strips_state_def 
    using dom_map_of_conv_image_fst[of "map (λ(v, a). ((v, a), the (s v) = a)) ?l"]
    by presburger
  also have " = fst ` (λ(v, a). ((v, a), the (s v) = a)) ` set ?l" 
    unfolding set_map
    by blast
  also have " = (λ(v, a). fst  ((v, a), the (s v) = a)) ` set ?l"
    unfolding image_comp[of fst "λ(v, a). ((v, a), the (s v) = a)"] comp_apply[of 
        fst "λ(v, a). ((v, a), the (s v) = a)"] prod.case_distrib
    by blast
  finally show ?thesis
    unfolding state_to_strips_state_dom_is_i[OF nb]
    by force
qed

corollary state_to_strips_state_dom_element_iff:
  assumes "is_valid_problem_sas_plus Ψ"
  shows "(v, a)  dom (φS Ψ s)  v  set ((Ψ)𝒱+)
     s v  None
     a  + Ψ v"
proof -
  let ?vs = "variables_of Ψ"
    and ?s' = "φS Ψ s"
  show ?thesis 
    proof (rule iffI)
      assume "(v, a)  dom (φS Ψ s)" 
      then have "v  { v | v. v  set ((Ψ)𝒱+)  s v  None }"
          and "a  + Ψ v"
        unfolding state_to_strips_state_dom_is[OF assms(1)]
        by force+
      moreover have "v  set ?vs" and "s v  None" 
        using calculation(1) 
        by fastforce+
      ultimately show 
        "v  set ((Ψ)𝒱+)  s v  None  a  + Ψ v"
        by force
    next 
      assume "v  set ((Ψ)𝒱+)  s v  None  a  + Ψ v"
      then have "v  set ((Ψ)𝒱+)" 
        and "s v  None"
        and a_in_range_of_v: "a  + Ψ v" 
        by simp+
      then have "v  { v | v. v  set ((Ψ)𝒱+)  s v  None }"
        by force
      thus "(v, a)  dom (φS Ψ s)"
        unfolding state_to_strips_state_dom_is[OF assms(1)]
        using a_in_range_of_v
        by blast
    qed
qed

lemma state_to_strips_state_range_is:
  assumes "is_valid_problem_sas_plus Ψ" 
    and "(v, a)  dom (φS Ψ s)" 
  shows "(φS Ψ s) (v, a) = Some (the (s v) = a)"
proof -
  let ?vs = "variables_of Ψ" 
  let ?s' = "φS Ψ s"
    and ?defined = "filter (λv. s v  None) ?vs"
  let ?l = "concat [possible_assignments_for Ψ v. v  ?defined]"
  have v_in_set_vs: "v  set ?vs" 
    and s_of_v_is_not_None: "s v  None" 
    and a_in_range_of_v: "a  + Ψ v" 
    using assms(2)
    unfolding state_to_strips_state_dom_is[OF assms(1)]
    by fastforce+
  moreover {
    have "v  set ((Ψ)𝒱+). v  dom (sas_plus_problem.range_of Ψ)"
      using assms(1) is_valid_problem_sas_plus_then(1)
      unfolding is_valid_problem_sas_plus_def
      by fastforce
    moreover have "(v, a)  set ?l" 
      unfolding state_to_strips_state_dom_is_i[OF calculation(1)]
      using s_of_v_is_not_None a_in_range_of_v v_in_set_vs
      by fastforce
    moreover have "set ?l  {}" 
      using calculation
      by fastforce
    ― ‹ TODO slow. ›
    ultimately have "(φS Ψ s) (v, a) = Some (the (s v) = a)"
      using map_of_from_function_graph_is_some_if[of 
          ?l "(v, a)" "λ(v, a). the (s v) = a"] 
      unfolding SAS_Plus_STRIPS.state_to_strips_state_def
        state_to_strips_state_def Let_def case_prod_beta'
      by fastforce
  }
  thus ?thesis.
qed


― ‹ Show that a STRIPS state corresponding to a SAS+ state via transformation is consistent
w.r.t. to the variable subset with same left component (i.e. the original SAS+ variable). This is
the consistency notion corresponding to SAS+ consistency: i.e. if no two assignments with different
values for the same variable exist in the SAS+ state, then assigning the corresponding assignment
both to @{text "True"} is impossible. Vice versa, if both are assigned to @{text "True"} then the
assignment variables must be the same SAS+ variable/SAS+ value pair. ›
lemma state_to_strips_state_effect_consistent:
  assumes "is_valid_problem_sas_plus Ψ"
    and "(v, a)  dom (φS Ψ s)"
    and "(v, a')  dom (φS Ψ s)"
    and "(φS Ψ s) (v, a) = Some True"
    and  "(φS Ψ s) (v, a') = Some True"
  shows "(v, a) = (v, a')" 
proof -
  have "the (s v) = a" and "the (s v) = a'"
    using state_to_strips_state_range_is[OF assms(1)] assms(2, 3, 4, 5)
    by fastforce+
  thus ?thesis 
    by argo
qed


lemma sasp_op_to_strips_set_delete_effects_is:
  assumes "is_valid_operator_sas_plus Ψ op" 
  shows "set (strips_operator.delete_effects_of (φO Ψ op)) 
    = ((v, a)  set (effect_of op). { (v, a') | a'. a'  (+ Ψ v)  a'  a })"
proof -
  let ?D = "range_of Ψ"
    and ?effect = "effect_of op" 
  let ?delete = "[(v, a'). (v, a)  ?effect, a'  filter ((≠) a) (the (?D v))]"
  {
    fix v a
    assume "(v, a)  set ?effect"
    then have "(+ Ψ v) = set (the (?D v))"
      using assms 
      using is_valid_operator_sas_plus_then_range_of_sas_plus_op_is_set_range_of_op
      by fastforce
    hence "set (filter ((≠) a) (the (?D v))) = { a'  + Ψ v. a'  a }"
      unfolding set_filter 
      by blast
  } note nb = this
  {
    ― ‹ TODO slow. ›
    have "set ?delete = (set ` (λ(v, a). map (Pair v) (filter ((≠) a) (the (?D v)))) 
      ` (set ?effect))" 
      using set_concat
      by simp
    also have " = ((λ(v, a). Pair v ` set (filter ((≠) a) (the (?D v)))) 
      ` (set ?effect))"
      unfolding image_comp[of set] set_map 
      by auto
    ― ‹ TODO slow. ›
    also have " = ((v, a)  set ?effect. Pair v ` { a'  + Ψ v. a'  a })" 
      using nb 
      by fast
    finally have "set ?delete = ((v, a)  set ?effect.
      { (v, a') | a'. a'  (+ Ψ v)  a'  a })" 
      by blast
  }
  thus ?thesis
    unfolding SAS_Plus_STRIPS.sasp_op_to_strips_def
      sasp_op_to_strips_def Let_def
    by force 
qed

lemma sas_plus_problem_to_strips_problem_variable_set_is:
  ― ‹ The variable set of Π› is the set of all possible 
assignments that are possible using the variables of 𝒱› and the corresponding domains. ›
  assumes "is_valid_problem_sas_plus Ψ" 
  shows "set ((φ Ψ)𝒱) = (v  set ((Ψ)𝒱+). { (v, a) | a. a  + Ψ v })"
proof -
  let  = "φ Ψ"
    and ?vs = "variables_of Ψ"
  {
    have "set (strips_problem.variables_of ) 
      = set [as. v  ?vs, as  possible_assignments_for Ψ v]"
      unfolding sas_plus_problem_to_strips_problem_def 
        SAS_Plus_STRIPS.sas_plus_problem_to_strips_problem_def
      by force
    also have " = ((set ` (λv. possible_assignments_for Ψ v) ` set ?vs))" 
      using set_concat
      by auto
    also have " = (((set  possible_assignments_for Ψ) ` set ?vs))" 
      using image_comp[of set "λv. possible_assignments_for Ψ v" "set ?vs"]
      by argo
    finally have "set (strips_problem.variables_of ) 
      = (v  set ?vs. set (possible_assignments_for Ψ v))"
      unfolding o_apply
      by blast
  }
  moreover have "v  set ?vs. v  dom (sas_plus_problem.range_of Ψ)"
    using is_valid_problem_sas_plus_dom_sas_plus_problem_range_of assms
    by force
  ultimately show ?thesis
    using possible_assignments_for_set_is
    by force 
qed

corollary sas_plus_problem_to_strips_problem_variable_set_element_iff:
  assumes "is_valid_problem_sas_plus Ψ"
  shows "(v, a)  set ((φ Ψ)𝒱)   v  set ((Ψ)𝒱+)  a  + Ψ v"
  unfolding sas_plus_problem_to_strips_problem_variable_set_is[OF assms]
  by fast

lemma sasp_op_to_strips_effect_consistent:
  assumes "op = φO Ψ op'" 
    and "op'  set ((Ψ)𝒪+)"
    and "is_valid_operator_sas_plus Ψ op'"
  shows "(v, a)  set (add_effects_of op)  (v, a)  set (delete_effects_of op)"
    and "(v, a)  set (delete_effects_of op)  (v, a)  set (add_effects_of op)"
proof -
  have nb: "((v, a)  set (effect_of op'). (v', a')  set (effect_of op'). v  v'  a = a')" 
    using assms(3)
    unfolding is_valid_operator_sas_plus_def 
      SAS_Plus_Representation.is_valid_operator_sas_plus_def list_all_iff ListMem_iff Let_def
    by argo
  {
    fix v a
    assume v_a_in_add_effects_of_op: "(v, a)  set (add_effects_of op)" 
    have "(v, a)  set (delete_effects_of op)" 
      proof (rule ccontr)
        assume "¬(v, a)  set (delete_effects_of op)" 
        moreover have "(v, a)  
          ((v, a')  set (effect_of op'). { (v, a'') 
            | a''. a''  (+ Ψ v)  a''  a' })"
          using calculation sasp_op_to_strips_set_delete_effects_is 
            assms 
          by blast
        moreover obtain a' where "(v, a')  set (effect_of op')" and "a  a'" 
          using calculation
          by blast
        moreover have "(v, a')  set (add_effects_of op)" 
          using assms(1) calculation(3)
          unfolding sasp_op_to_strips_def
            SAS_Plus_STRIPS.sasp_op_to_strips_def
            Let_def
          by fastforce
        moreover have "(v, a)  set (effect_of op')" and "(v, a')  set (effect_of op')" 
          using assms(1) v_a_in_add_effects_of_op calculation(5)
          unfolding sasp_op_to_strips_def 
            SAS_Plus_STRIPS.sasp_op_to_strips_def
            Let_def 
          by force+
        ultimately show False 
          using nb 
          by fast
      qed
  }
  moreover {
    fix v a
    assume v_a_in_delete_effects_of_op: "(v, a)  set (delete_effects_of op)" 
    have "(v, a)  set (add_effects_of op)" 
      proof (rule ccontr)
        assume "¬(v, a)  set (add_effects_of op)" 
        moreover have "(v, a)  set (add_effects_of op)" 
          using calculation 
          by blast
        moreover have "(v, a)  
          ((v, a')  set (effect_of op'). { (v, a'') 
            | a''. a''  (+ Ψ v)  a''  a' })"
          using sasp_op_to_strips_set_delete_effects_is  
            nb assms(1, 3) v_a_in_delete_effects_of_op
          by force
        moreover obtain a' where "(v, a')  set (effect_of op')" and "a  a'" 
          using calculation
          by blast
        moreover have "(v, a')  set (add_effects_of op)" 
          using assms(1) calculation(4)
          unfolding sasp_op_to_strips_def 
            SAS_Plus_STRIPS.sasp_op_to_strips_def
            Let_def
          by fastforce
        moreover have "(v, a)  set (effect_of op')" and "(v, a')  set (effect_of op')" 
          using assms(1) calculation(2, 6)
          unfolding sasp_op_to_strips_def 
            SAS_Plus_STRIPS.sasp_op_to_strips_def Let_def 
          by force+
        ultimately show False 
          using nb 
          by fast
      qed
    }
    ultimately show "(v, a)  set (add_effects_of op) 
       (v, a)  set (delete_effects_of op)"
      and "(v, a)  set (delete_effects_of op) 
       (v, a)  set (add_effects_of op)"
      by blast+
  qed

lemma is_valid_problem_sas_plus_then_strips_transformation_too_iii:
  assumes "is_valid_problem_sas_plus Ψ" 
  shows "list_all (is_valid_operator_strips (φ Ψ))
    (strips_problem.operators_of (φ Ψ))"
proof -
  let  = "φ Ψ"
  let ?vs = "strips_problem.variables_of "
  {
    fix op
    assume "op  set (strips_problem.operators_of )" 
    ― ‹ TODO slow. ›
    then obtain op' 
      where op_is: "op = φO Ψ op'" 
        and op'_in_operators: "op'  set ((Ψ)𝒪+)" 
      unfolding SAS_Plus_STRIPS.sas_plus_problem_to_strips_problem_def
        sas_plus_problem_to_strips_problem_def 
        sasp_op_to_strips_def 
      by auto
    then have is_valid_op': "is_valid_operator_sas_plus Ψ op'"
      using sublocale_sas_plus_finite_domain_representation_ii(2)[OF assms]
      by blast
    moreover {
      fix v a
      assume "(v, a)  set (strips_operator.precondition_of op)"
      ― ‹ TODO slow. ›
      then have "(v, a)  set (sas_plus_operator.precondition_of op')" 
        using op_is
        unfolding SAS_Plus_STRIPS.sasp_op_to_strips_def 
          sasp_op_to_strips_def
        by force
      moreover have "v  set ((Ψ)𝒱+)" 
        using is_valid_op' calculation
        using is_valid_operator_sas_plus_then(1)
        by fastforce 
      moreover have  "a  + Ψ v" 
        using is_valid_op' calculation(1)
        using is_valid_operator_sas_plus_then(2) 
        by fast
      ultimately have "(v, a)  set ?vs" 
        using sas_plus_problem_to_strips_problem_variable_set_element_iff[OF assms(1)]
        by force
    }
    moreover {
      fix v a
      assume "(v, a)  set (strips_operator.add_effects_of op)"
      then have "(v, a)  set (effect_of op')" 
        using op_is
        unfolding SAS_Plus_STRIPS.sasp_op_to_strips_def
          sasp_op_to_strips_def
        by force
      then have "v  set ((Ψ)𝒱+)" and "a  + Ψ v" 
        using is_valid_operator_sas_plus_then is_valid_op'
        by fastforce+
      hence "(v, a)  set ?vs" 
        using sas_plus_problem_to_strips_problem_variable_set_element_iff[OF assms(1)]
        by force
    }
    moreover {
      fix v a'
      assume v_a'_in_delete_effects: "(v, a')  set (strips_operator.delete_effects_of op)"
      moreover have "set (strips_operator.delete_effects_of op) 
        =  ((v, a)  set (effect_of op'). 
          { (v, a') | a'. a'  (+ Ψ v)  a'  a })"
        using sasp_op_to_strips_set_delete_effects_is[OF is_valid_op']
          op_is
        by simp
      ― ‹ TODO slow. ›
      ultimately obtain a 
        where "(v, a)  set (effect_of op')" 
          and a'_in: "a'  { a'  + Ψ v. a'  a }"
        by blast 
      moreover have "is_valid_operator_sas_plus Ψ op'"
        using op'_in_operators assms(1) 
          is_valid_problem_sas_plus_then(2)
        by blast
      moreover have "v  set ((Ψ)𝒱+)"
        using is_valid_operator_sas_plus_then calculation(1, 3)
        by fast
      moreover have "a'  + Ψ v"
        using a'_in 
        by blast
      ultimately have "(v, a')  set ?vs" 
        using sas_plus_problem_to_strips_problem_variable_set_element_iff[OF assms(1)]
        by force
    }
    ultimately have "set (strips_operator.precondition_of op)  set ?vs
       set (strips_operator.add_effects_of op)  set ?vs
       set (strips_operator.delete_effects_of op)  set ?vs
       (vset (add_effects_of op). v  set (delete_effects_of op))
       (vset (delete_effects_of op). v  set (add_effects_of op))"
      using sasp_op_to_strips_effect_consistent[OF 
          op_is op'_in_operators is_valid_op']
      by fast+
  }
  thus ?thesis
    unfolding is_valid_operator_strips_def STRIPS_Representation.is_valid_operator_strips_def 
      list_all_iff ListMem_iff Let_def 
    by blast
qed

lemma is_valid_problem_sas_plus_then_strips_transformation_too_iv:
  assumes "is_valid_problem_sas_plus Ψ"
  shows "x. ((φ Ψ)I) x  None
     ListMem x (strips_problem.variables_of (φ Ψ))"
proof -
  let ?vs = "variables_of Ψ"
    and ?I = "initial_of Ψ"
    and  = "φ Ψ"
  let ?vs' = "strips_problem.variables_of "
    and ?I' = "strips_problem.initial_of "
  {
    fix x
    have "?I' x  None  ListMem x ?vs'" 
      proof (rule iffI)
        assume I'_of_x_is_not_None: "?I' x  None"
        then have "x  dom ?I'" 
          by blast
        moreover obtain v a where x_is: "x = (v, a)" 
          by fastforce
        ultimately have "(v, a)  dom ?I'" 
          by blast
        then have "v  set ?vs" 
            and "?I v  None"
            and "a  + Ψ v"
          using state_to_strips_state_dom_element_iff[OF assms(1), of v a  ?I] 
          unfolding sas_plus_problem_to_strips_problem_def 
            SAS_Plus_STRIPS.sas_plus_problem_to_strips_problem_def 
            state_to_strips_state_def
            SAS_Plus_STRIPS.state_to_strips_state_def 
          by simp+
        thus "ListMem x ?vs'"
          unfolding ListMem_iff
          using sas_plus_problem_to_strips_problem_variable_set_element_iff[OF assms(1)] 
            x_is
          by auto
      next 
        assume list_mem_x_vs': "ListMem x ?vs'"
        then obtain v a where x_is: "x = (v, a)" 
          by fastforce
        then have "(v, a)  set ?vs'" 
          using list_mem_x_vs'
          unfolding ListMem_iff
          by blast
        then have "v  set ?vs" and "a  + Ψ v" 
          using sas_plus_problem_to_strips_problem_variable_set_element_iff[OF assms(1)]
          by force+
        moreover have "?I v  None" 
          using is_valid_problem_sas_plus_then(3) assms(1) calculation(1)
          by auto
        ultimately have "(v, a)  dom ?I'" 
          using state_to_strips_state_dom_element_iff[OF assms(1), of v a ?I]
          unfolding SAS_Plus_STRIPS.sas_plus_problem_to_strips_problem_def 
            sas_plus_problem_to_strips_problem_def
            SAS_Plus_STRIPS.state_to_strips_state_def
            state_to_strips_state_def
          by force 
        thus "?I' x  None"
          using x_is 
          by fastforce
      qed
  }
  thus ?thesis
    by simp
qed

private lemma is_valid_problem_sas_plus_then_strips_transformation_too_v:
  assumes "is_valid_problem_sas_plus Ψ"
  shows "x. ((φ Ψ)G) x  None
     ListMem x (strips_problem.variables_of (φ Ψ))"
proof -
  let ?vs = "variables_of Ψ"
    and ?D = "range_of Ψ"
    and ?G = "goal_of Ψ"
  let  = "φ Ψ"
  let ?vs' = "strips_problem.variables_of "
    and ?G' = "strips_problem.goal_of " 
  have nb: "?G' = φS Ψ ?G" 
    by simp
  {
    fix x
    assume "?G' x  None" 
    moreover obtain v a where "x = (v, a)" 
      by fastforce
    moreover have "(v, a)  dom ?G'" 
      using domIff calculation(1, 2)
      by blast
    moreover have "v  set ?vs" and "a  + Ψ v"
      using state_to_strips_state_dom_is[OF assms(1), of ?G] nb calculation(3)
      by auto+
    ultimately have "x  set ?vs'"
      using sas_plus_problem_to_strips_problem_variable_set_element_iff[OF assms(1)]
      by auto
  }
  thus ?thesis 
    unfolding ListMem_iff
    by simp
qed

text ‹ We now show that given termΨ is a valid SASPlus problem, then termΠ  φ Ψ is a valid
STRIPS problem as well. 
The proof unfolds the definition of term‹is_valid_problem_strips› and then shows each of the conjuncts 
for termΠ. These are:
\begin{itemize}
  \item termΠ has at least one variable;
  \item termΠ has at least one operator;
  \item all operators are valid STRIPS operators;
  \item term(Π::'a strips_problem)I is defined for all variables in term(Π::'a strips_problem)𝒱; and finally,
  \item if term((Π::'a strips_problem)G) x is defined, then termx is in term(Π::'a strips_problem)𝒱.
\end{itemize} ›

theorem
  is_valid_problem_sas_plus_then_strips_transformation_too:
  assumes "is_valid_problem_sas_plus Ψ"
  shows "is_valid_problem_strips (φ Ψ)" 
proof -
  let  = "φ Ψ"
  have "list_all (is_valid_operator_strips (φ Ψ))
   (strips_problem.operators_of (φ Ψ))" 
    using is_valid_problem_sas_plus_then_strips_transformation_too_iii[OF assms].
  moreover have "x. (((φ Ψ)I) x  None) =
    ListMem x (strips_problem.variables_of (φ Ψ))" 
    using is_valid_problem_sas_plus_then_strips_transformation_too_iv[OF assms].
  moreover have "x. ((φ Ψ)G) x  None 
    ListMem x (strips_problem.variables_of (φ Ψ))" 
    using is_valid_problem_sas_plus_then_strips_transformation_too_v[OF assms].
  ultimately show ?thesis 
    using is_valid_problem_strips_def 
    unfolding STRIPS_Representation.is_valid_problem_strips_def
    by fastforce
qed 

lemma set_filter_all_possible_assignments_true_is:
  assumes "is_valid_problem_sas_plus Ψ" 
  shows "set (filter (λ(v, a). s (v, a) = Some True) 
      (all_possible_assignments_for Ψ))
    =  (v  set ((Ψ)𝒱+). Pair v ` { a  + Ψ v. s (v, a) = Some True })"
proof -
  let ?vs = "sas_plus_problem.variables_of Ψ"
    and ?P = "(λ(v, a). s (v, a) = Some True)"
  let ?l = "filter ?P (all_possible_assignments_for Ψ)"
  have "set ?l = set (concat (map (filter ?P) (map (possible_assignments_for Ψ) ?vs)))" 
    unfolding all_possible_assignments_for_def
      filter_concat[of ?P "map (possible_assignments_for Ψ) (sas_plus_problem.variables_of Ψ)"]
    by simp
  also have " = set (concat (map (λv. filter ?P (possible_assignments_for Ψ v)) ?vs))" 
    unfolding map_map comp_apply 
    by blast
  also have " = set (concat (map (λv. map (Pair v) 
    (filter (?P  Pair v) (the (range_of Ψ v)))) ?vs))" 
    unfolding possible_assignments_for_def filter_map
    by blast
  also have " = set (concat (map (λv. map (Pair v) (filter (λa. s (v, a) = Some True) 
    (the (range_of Ψ v)))) ?vs))" 
    unfolding comp_apply
    by fast
  also have " = (set ` ((λv. map (Pair v) (filter (λa. s (v, a) = Some True) 
    (the (range_of Ψ v)))) ` set ?vs))"
    unfolding set_concat set_map..
  also have " = (v  set ?vs. Pair v ` set (filter (λa. s (v, a) = Some True) 
    (the (range_of Ψ v))))" 
    unfolding image_comp[of set] comp_apply set_map..
  also have " = (v  set ?vs. Pair v 
    ` { a  set (the (range_of Ψ v)). s (v, a) = Some True })"
    unfolding set_filter..
  finally show ?thesis 
    using set_the_range_of_is_range_of_sas_plus_if[OF assms(1)]
    by auto
qed

lemma strips_state_to_state_dom_is: 
  assumes "is_valid_problem_sas_plus Ψ" 
  shows "dom (φS¯ Ψ s) 
    = (v  set ((Ψ)𝒱+). 
      { v | a. a  (+ Ψ v)  s (v, a) = Some True })"
proof -
  let ?vs = "variables_of Ψ"
    and ?s' = "φS¯ Ψ s" 
    and ?P = "(λ(v, a). s (v, a) = Some True)"
  let ?l = "filter ?P (all_possible_assignments_for Ψ)"
  { 
    have "fst ` set ?l = fst ` (v  set ?vs. Pair v 
      ` { a  + Ψ v. s (v, a) = Some True })"
      unfolding set_filter_all_possible_assignments_true_is[OF assms]
      by auto
    also have " = (v  set ?vs. fst ` Pair v 
      ` { a  + Ψ v. s (v, a) = Some True })" 
      by blast
    also have " = (v  set ?vs. (λa. fst (Pair v a)) ` 
      { a  + Ψ v. s (v, a) = Some True })" 
      unfolding image_comp[of fst] comp_apply
      by blast
    finally have "fst ` set ?l = (v  set ((Ψ)𝒱+). 
      { v | a. a  (+ Ψ v)  s (v, a) = Some True })" 
      unfolding setcompr_eq_image fst_conv 
      by simp
  }
  thus ?thesis
    unfolding SAS_Plus_STRIPS.strips_state_to_state_def 
      strips_state_to_state_def dom_map_of_conv_image_fst
    by blast
qed

lemma strips_state_to_state_range_is: 
  assumes "is_valid_problem_sas_plus Ψ" 
    and "v  set ((Ψ)𝒱+)"
    and "a  + Ψ v" 
    and "(v, a)  dom s'"
    and "(v, a)  dom s'. (v, a')  dom s'. s' (v, a) = Some True  s' (v, a') = Some True 
       (v, a) = (v, a')" 
  shows "(φS¯ Ψ s') v = Some a  the (s' (v, a))" 
proof -
  let ?vs = "variables_of Ψ"
    and ?D = "range_of Ψ"
    and ?s = "φS¯ Ψ s'"
  let ?as = "all_possible_assignments_for Ψ"
  let ?l = "filter (λ(v, a). s' (v, a) = Some True) ?as"
  show ?thesis 
    proof (rule iffI)
      assume s_of_v_is_Some_a: "?s v = Some a" 
      {
        have "(v, a)  set ?l" 
          using s_of_v_is_Some_a 
          unfolding SAS_Plus_STRIPS.strips_state_to_state_def 
            strips_state_to_state_def 
          using map_of_SomeD
          by fast
        hence "s' (v, a) = Some True"
          unfolding all_possible_assignments_for_set_is set_filter
          by blast
      }
      thus "the (s' (v, a))"
        by simp
    next 
      assume the_of_s'_of_v_a_is: "the (s' (v, a))"
      then have s'_of_v_a_is_Some_true: "s' (v, a) = Some True"
        using assms(4) domIff 
        by force
      ― ‹ TODO slow. ›
      moreover {
        fix v v' a a'
        assume "(v, a)  set ?l" and "(v', a')  set ?l"
        then have "v  v'  a = a'" 
        using assms(5)
        by fastforce
      }
      moreover {
        have "v  set ((Ψ)𝒱+). sas_plus_problem.range_of Ψ v  None"  
          using is_valid_problem_sas_plus_then(1) assms(1)
            range_of_not_empty 
          by force
        (* TODO slow. *)
        moreover have "set ?l = Set.filter (λ(v, a). s' (v, a) = Some True) 
          (v  set ((Ψ)𝒱+). { (v, a) | a.  a  + Ψ v })"
          using all_possible_assignments_for_set_is calculation
          by force
        ultimately have "(v, a)  set ?l" 
          using assms(2, 3) s'_of_v_a_is_Some_true
          by simp
      }
      ultimately show "?s v = Some a"  
        using map_of_constant_assignments_defined_if[of ?l v a]
        unfolding SAS_Plus_STRIPS.strips_state_to_state_def
          strips_state_to_state_def
        by blast
    qed
qed

― ‹ NOTE A technical lemma which characterizes the return values for possible assignments 
@{text "(v, a)"} when used as variables on a state @{text "s"} which was transformed from. › 
lemma strips_state_to_state_inverse_is_i:
assumes "is_valid_problem_sas_plus Ψ"
  and "v  set ((Ψ)𝒱+)"
  and "s v  None" 
  and "a  + Ψ v" 
shows "(φS Ψ s) (v, a) = Some (the (s v) = a)"
proof -
   let ?vs = "sas_plus_problem.variables_of Ψ"
  let ?s' = "φS Ψ s"
    and ?f = "λ(v, a). the (s v) = a"
    and ?l = "concat (map (possible_assignments_for Ψ) (filter (λv. s v  None) ?vs))"
  have "(v, a)  dom ?s'" 
    using state_to_strips_state_dom_element_iff[
        OF assms(1)] assms(2, 3, 4)
    by presburger
  {
    have "v  { v | v. v  set ((Ψ)𝒱+)  s v  None }"
      using assms(2, 3)
      by blast
    moreover have "v  set ((Ψ)𝒱+). v  dom (sas_plus_problem.range_of Ψ)"
      using is_valid_problem_sas_plus_dom_sas_plus_problem_range_of[OF assms(1)]. 
    moreover have "set ?l = (v  { v | v. v  set ((Ψ)𝒱+)  s v  None }. 
      { (v, a) |a. a  + Ψ v })"
      unfolding state_to_strips_state_dom_is_i[OF calculation(2)]
      by blast
    ultimately have "(v, a)  set ?l" 
      using assms(4)
      by blast
  }
  moreover have "set ?l  {}" 
    using calculation
    by force
  ― ‹ TODO slow.›
  ultimately show ?thesis 
    unfolding SAS_Plus_STRIPS.state_to_strips_state_def
      state_to_strips_state_def 
    using map_of_from_function_graph_is_some_if[of ?l "(v, a)" ?f] 
    unfolding split_def
    by fastforce
qed

― ‹ NOTE Show that the transformed strips state is consistent for pairs of assignments 
@{text "(v, a)"} and @{text "(v, a')"} in the same variable domain. ›
(* TODO make private. *)
corollary strips_state_to_state_inverse_is_ii:
assumes "is_valid_problem_sas_plus Ψ"
  and "v  set ((Ψ)𝒱+)"
  and "s v = Some a"  
  and "a  + Ψ v" 
  and "a'  + Ψ v" 
  and "a'  a"
shows "(φS Ψ s) (v, a') = Some False"
proof -
  have "s v  None" 
    using assms(3) 
    by simp
  moreover have "the (s v)  a'" 
    using assms(3, 6) 
    by simp 
  ultimately show ?thesis 
    using strips_state_to_state_inverse_is_i[OF assms(1, 2) _ assms(5)]
    by force
qed

― ‹ NOTE Follows from the corollary above by contraposition. ›
(* TODO make private. *)
corollary strips_state_to_state_inverse_is_iii:
assumes "is_valid_problem_sas_plus Ψ"
  and "v  set ((Ψ)𝒱+)"
  and "s v = Some a" 
  and "a  + Ψ v" 
  and "a'  + Ψ v" 
  and "(φS Ψ s) (v, a) = Some True"
  and "(φS Ψ s) (v, a') = Some True"
shows "a = a'"
proof -
  have "s v  None" 
    using assms(3)
    by blast
  thus ?thesis 
    using strips_state_to_state_inverse_is_i[OF assms(1, 2)] assms(4, 5, 6, 7)
    by auto
qed

(* TODO make private. *)
lemma strips_state_to_state_inverse_is_iv:
  assumes "is_valid_problem_sas_plus Ψ"
    and "dom s  set ((Ψ)𝒱+)"
    and "v  set ((Ψ)𝒱+)" 
    and "s v = Some a" 
    and "a  + Ψ v" 
  shows "(φS¯ Ψ (φS Ψ s)) v = Some a"
proof -
  let ?vs = "variables_of Ψ"
    and ?s' = "φS Ψ s"
  let ?s'' = "φS¯ Ψ ?s'" 
  let ?P = "λ(v, a). ?s' (v, a) = Some True"
  let ?as = "filter ?P (all_possible_assignments_for Ψ)" 
    and ?As = "Set.filter ?P (v  set ((Ψ)𝒱+). 
      { (v, a) | a. a  + Ψ v })"
  {
    have "v  set ((Ψ)𝒱+). range_of Ψ v  None"
      using sublocale_sas_plus_finite_domain_representation_ii(1)[OF assms(1)] 
        range_of_not_empty
      by force
    (* TODO slow. *)
    hence "set ?as = ?As"
      unfolding set_filter 
      using all_possible_assignments_for_set_is
      by force
  } note nb = this
  moreover {
    {
      fix v v' a a' 
      assume "(v, a)  set ?as" 
        and "(v', a')  set ?as" 
      then have "(v, a)  ?As" and "(v', a')  ?As" 
        using nb 
        by blast+
      then have v_in_set_vs: "v  set ?vs" and v'_in_set_vs: "v'  set ?vs"
        and a_in_range_of_v: "a  + Ψ v" 
        and a'_in_range_of_v: "a'  + Ψ v'" 
        and s'_of_v_a_is: "?s' (v, a) = Some True" and s'_of_v'_a'_is: "?s' (v', a') = Some True" 
        by fastforce+
      then have "(v, a)  dom ?s'"  
        by blast
      then have s_of_v_is_Some_a: "s v = Some a"  
        using state_to_strips_state_dom_element_iff[OF assms(1)]
          state_to_strips_state_range_is[OF assms(1)] s'_of_v_a_is 
           by auto
      have "v  v'  a = a'"
        proof (rule ccontr)
          assume "¬(v  v'  a = a')"
          then have "v = v'" and "a  a'" 
            by simp+
          thus False
            using a'_in_range_of_v a_in_range_of_v assms(1) v'_in_set_vs s'_of_v'_a'_is 
              s'_of_v_a_is s_of_v_is_Some_a strips_state_to_state_inverse_is_iii
            by force
        qed
    }
    moreover {
      have "s v  None" 
        using assms(4)
        by simp
      then have "?s' (v, a) = Some True" 
        using strips_state_to_state_inverse_is_i[OF assms(1, 3) _ assms(5)] 
          assms(4)
        by simp
      (* TODO slow *)
      hence "(v, a)  set ?as" 
        using all_possible_assignments_for_set_is assms(3, 5) nb
        by simp
    }
    ultimately have "map_of ?as v = Some a" 
      using map_of_constant_assignments_defined_if[of ?as v a] 
      by blast
  }
  ― ‹ TODO slow. ›
  thus ?thesis
    unfolding SAS_Plus_STRIPS.strips_state_to_state_def
      strips_state_to_state_def all_possible_assignments_for_def
    by simp
qed

(* TODO the constraints on the state @{text "s"} could be refactored into a definition of valid 
states for a problem description. *)
(* TODO The proof is not very elegant. Should be simplified. *)
― ‹ Show that that φS¯ Ψ› is the inverse of φS Ψ›. The additional constraints 
term‹dom s = set ((Ψ)𝒱+) and termv  dom s. the (s v)  + Ψ v are needed because the 
transformation functions only take into account variables and domains declared in the problem 
description. They also sufficiently characterize a state that was transformed from SAS+ to STRIPS. ›
lemma strips_state_to_state_inverse_is:
  assumes "is_valid_problem_sas_plus Ψ"
    and "dom s  set ((Ψ)𝒱+)"
    and "v  dom s. the (s v)  + Ψ v" 
  shows "s = (φS¯ Ψ (φS Ψ s))"
proof -
  let ?vs = "variables_of Ψ"
    and ?D = "range_of Ψ"
  let ?s' = "φS Ψ s" 
  let ?s'' = "φS¯ Ψ ?s'"
  ― ‹ NOTE Show the thesis by proving that @{text "s"} and @{text "?s'"} are mutual submaps. ›
  {
    fix v
    assume v_in_dom_s: "v  dom s"
    then have v_in_set_vs: "v  set ?vs" 
      using assms(2) 
      by auto
    then obtain a 
      where the_s_v_is_a: "s v = Some a" 
        and a_in_dom_v: "a  + Ψ v" 
      using assms(2, 3) v_in_dom_s
      by force
    moreover have "?s'' v = Some a" 
      using strips_state_to_state_inverse_is_iv[OF assms(1, 2)] v_in_set_vs
        the_s_v_is_a a_in_dom_v 
      by force
    ultimately have "s v = ?s'' v"
      by argo
  } note nb = this
  moreover {
    fix v
    assume "v  dom ?s''"
    then obtain a 
      where "a  + Ψ v" 
        and "?s' (v, a) = Some True" 
      using strips_state_to_state_dom_is[OF assms(1)]
      by blast
    then have "(v, a)  dom ?s'" 
      by blast
    then have "s v  None" 
      using state_to_strips_state_dom_is[OF assms(1)]
      by simp
    then obtain a where "s v = Some a" 
      by blast
    hence "?s'' v = s v"
      using nb 
      by fastforce
  }
  ― ‹ TODO slow.›
  ultimately show ?thesis 
    using map_le_antisym[of s ?s''] map_le_def
    unfolding strips_state_to_state_def 
      state_to_strips_state_def
    by blast
qed

― ‹ An important lemma which shows that the submap relation does not change if we transform the 
states on either side from SAS+ to STRIPS. 
% TODO what is this called generally? Predicate monotony?? ›
lemma state_to_strips_state_map_le_iff:
  assumes "is_valid_problem_sas_plus Ψ"
    and "dom s  set ((Ψ)𝒱+)" 
    and "v  dom s. the (s v)  + Ψ v" 
  shows "s m t  (φS Ψ s) m (φS Ψ t)"
proof -
  let ?vs = "variables_of Ψ"
    and ?D = "range_of Ψ"
    and ?s' = "φS Ψ s" 
    and ?t' = "φS Ψ t" 
  show ?thesis
    proof (rule iffI)
      assume s_map_le_t: "s m t"
      {
        fix v a
        assume "(v, a)  dom ?s'" 
        moreover have "v  set ((Ψ)𝒱+)" and "s v  None" and "a  + Ψ v"
          using state_to_strips_state_dom_is[OF assms(1)] calculation 
          by blast+
        moreover have "?s' (v, a) = Some (the (s v) = a)"
          using state_to_strips_state_range_is[OF assms(1)] calculation(1) 
          by meson
        moreover have "v  dom s" 
          using calculation(3)
          by auto 
        moreover have "s v = t v" 
          using s_map_le_t calculation(6) 
          unfolding map_le_def
          by blast
        moreover have "t v  None" 
          using calculation(3, 7)
          by argo
        moreover have "(v, a)  dom ?t'" 
          using state_to_strips_state_dom_is[OF assms(1)] calculation(2, 4, 8) 
          by blast
        moreover have "?t' (v, a) = Some (the (t v) = a)" 
          using state_to_strips_state_range_is[OF assms(1)] calculation(9)
          by simp
        ultimately have "?s' (v, a) = ?t' (v, a)"
          by presburger
      }
      thus "?s' m ?t'" 
        unfolding map_le_def 
        by fast
    next
      assume s'_map_le_t': "?s' m ?t'"
      {
        fix v 
        assume v_in_dom_s: "v  dom s" 
        moreover obtain a where the_of_s_of_v_is_a: "the (s v) = a" 
          by blast
        moreover have v_in_vs: "v  set ((Ψ)𝒱+)" 
          and s_of_v_is_not_None: "s v  None" 
          and a_in_range_of_v: "a  + Ψ v"
          using assms(2, 3) v_in_dom_s calculation
          by blast+
        moreover have "(v, a)  dom ?s'"  
          using state_to_strips_state_dom_is[OF assms(1)] 
            calculation(3, 4, 5)
          by simp
        moreover have "?s' (v, a) = ?t' (v, a)"
          using s'_map_le_t' calculation
          unfolding map_le_def 
          by blast
        moreover have "(v, a)  dom ?t'" 
          using calculation 
          unfolding domIff
          by argo
        moreover have "?s' (v, a) = Some (the (s v) = a)"
          and "?t' (v, a) = Some (the (t v) = a)" 
          using state_to_strips_state_range_is[OF assms(1)] calculation
          by fast+
        moreover have "s v = Some a" 
          using calculation(2, 4) 
          by force
        moreover have "?s' (v, a) = Some True" 
          using calculation(9, 11)
          by fastforce
        moreover have "?t' (v, a) = Some True" 
          using calculation(7, 12)
          by argo
        moreover have "the (t v) = a" 
          using calculation(10, 13) try0
          by force
        moreover {
          have "v  dom t" 
            using state_to_strips_state_dom_element_iff[OF assms(1)] 
              calculation(8) 
            by auto
          hence "t v = Some a"
            using calculation(14)
            by force
        }
        ultimately have "s v = t v"
          by argo
      }
      thus "s m t"
        unfolding map_le_def
        by simp
    qed
qed

― ‹ We also show that φO¯ Π› is the inverse of φO Ψ›. Note that this proof is completely 
mechanical since both the precondition and effect lists are simply being copied when transforming 
from SAS+ to STRIPS and when transforming back from STRIPS to SAS+. ›
(* TODO rename ‹sasp_op_to_strips_inverse_is› *)
(* TODO prune assumptions (not required) *)
lemma sas_plus_operator_inverse_is:
  assumes "is_valid_problem_sas_plus Ψ"
    and "op  set ((Ψ)𝒪+)" 
  shows "(φO¯ Ψ (φO Ψ op)) = op"
proof -
  let ?op = "φO¯ Ψ (φO Ψ op)"
  have "precondition_of ?op = precondition_of op"
    unfolding SAS_Plus_STRIPS.strips_op_to_sasp_def
      strips_op_to_sasp_def
      SAS_Plus_STRIPS.sasp_op_to_strips_def
      sasp_op_to_strips_def
    by fastforce
  moreover have "effect_of ?op = effect_of op" 
    unfolding SAS_Plus_STRIPS.strips_op_to_sasp_def
      strips_op_to_sasp_def
      SAS_Plus_STRIPS.sasp_op_to_strips_def
      sasp_op_to_strips_def
    by force
  ultimately show ?thesis 
    by simp
qed

― ‹ Note that we have to make the assumption that op'› is a member of the operator set of the 
induced STRIPS problem φ Ψ›. This implies that op'› was transformed from an 
op ∈ operators_of Ψ›. If we don't make this assumption, then multiple STRIPS operators of the 
form  ⦇ precondition_of = [], add_effects_of = [], delete_effects_of = [(v, a), ...] ⦈› correspond 
to one SAS+ operator (since the delete effects are being discarded in the transformation function). 
›
lemma strips_operator_inverse_is:
  assumes "is_valid_problem_sas_plus Ψ"
    and "op'  set ((φ Ψ)𝒪)" 
  shows "(φO Ψ (φO¯ Ψ op')) = op'" 
  proof -
    let  = "φ Ψ"
    obtain op where "op  set ((Ψ)𝒪+)" and "op' = φO Ψ op" 
      using assms 
      by auto
    moreover have "φO¯ Ψ op' = op" 
      using sas_plus_operator_inverse_is[OF assms(1) calculation(1)] calculation(2)
      by blast
    ultimately show ?thesis
      by argo
  qed

(* 
  ▪ TODO Simplify | refactor proof. 
  ▪ TODO make private. *)
lemma sas_plus_equivalent_to_strips_i_a_I:
  assumes "is_valid_problem_sas_plus Ψ"
    and "set ops'  set ((φ Ψ)𝒪)"
    and "STRIPS_Semantics.are_all_operators_applicable (φS Ψ s) ops'"
    and "op  set [φO¯ Ψ op'. op'  ops']" 
  shows "map_of (precondition_of op) m (φS¯ Ψ (φS Ψ s))" 
proof -
  let  = "φ Ψ"
    and ?s' = "φS Ψ s" 
  let ?s = "φS¯ Ψ ?s'" 
    and ?D = "range_of Ψ"
    and ?ops = "[φO¯ Ψ op'. op'  ops']" 
    and ?pre = "precondition_of op" 
  have nb1: "(v, a)  dom ?s'. 
    (v, a')  dom ?s'. 
      ?s' (v, a) = Some True  ?s' (v, a') = Some True
       (v, a) = (v, a')" 
    using state_to_strips_state_effect_consistent[OF assms(1)] 
    by blast
  {
    fix op'
    assume "op'  set ops'" 
    moreover have "op'  set (()𝒪)"
      using assms(2) calculation 
      by blast
    ultimately have "op  set ((Ψ)𝒪+). op' = (φO Ψ op)" 
      by auto
  } note nb2 = this
  {
    fix op
    assume "op  set ?ops" 
    then obtain op' where "op'  set ops'" and "op = φO¯ Ψ op'" 
      using assms(4) 
      by auto
    moreover obtain op'' where "op''  set ((Ψ)𝒪+)" and "op' = φO Ψ op''" 
      using nb2 calculation(1)
      by blast
    moreover have "op = op''"
      using sas_plus_operator_inverse_is[OF assms(1) calculation(3)] calculation(2, 4)  
      by blast
    ultimately have "op  set ((Ψ)𝒪+)"
      by blast
  } note nb3 = this
  {
    fix op v a
    assume "op  set ?ops" 
      and v_a_in_precondition_of_op': "(v, a)  set (precondition_of op)"
    moreover obtain op' where "op'  set ops'" and "op = φO¯ Ψ op'" 
      using calculation(1) 
      by auto
    moreover have "strips_operator.precondition_of op' = precondition_of op" 
      using calculation(4) 
      unfolding SAS_Plus_STRIPS.strips_op_to_sasp_def
        strips_op_to_sasp_def
      by simp
    ultimately have "op'  set ops'. op = (φO¯ Ψ op')
       (v, a)  set (strips_operator.precondition_of op')" 
      by metis
  } note nb4 = this
  {
    fix op' v a
    assume "op'  set ops'" 
      and v_a_in_precondition_of_op': "(v, a)  set (strips_operator.precondition_of op')"
    moreover have s'_of_v_a_is_Some_True: "?s' (v, a) = Some True" 
      using assms(3) calculation(1, 2) 
      unfolding are_all_operators_applicable_set
      by blast
    moreover {
      obtain op where "op  set ((Ψ)𝒪+)" and "op' = φO Ψ op" 
        using nb2 calculation(1) 
        by blast
      moreover have "strips_operator.precondition_of op' = precondition_of op" 
        using calculation(2) 
        unfolding SAS_Plus_STRIPS.sasp_op_to_strips_def
          sasp_op_to_strips_def
        by simp
      moreover have "(v, a)  set (precondition_of op)"
        using v_a_in_precondition_of_op' calculation(3)
        by argo
      moreover have "is_valid_operator_sas_plus Ψ op" 
        using is_valid_problem_sas_plus_then(2) assms(1) calculation(1)
        unfolding is_valid_operator_sas_plus_def
        by auto
      moreover have "v  set ((Ψ)𝒱+)" and "a  + Ψ v" 
        using is_valid_operator_sas_plus_then(1,2) calculation(4, 5)
        unfolding is_valid_operator_sas_plus_def
        by fastforce+
      moreover have "v  dom ?s" 
        using strips_state_to_state_dom_is[OF assms(1), of ?s'] 
          s'_of_v_a_is_Some_True calculation(6, 7)
        by blast
      moreover have "(v, a)  dom ?s'" 
        using s'_of_v_a_is_Some_True domIff 
        by blast
      ultimately have "?s v = Some a"
        using strips_state_to_state_range_is[OF assms(1) _ _ _ nb1] 
          s'_of_v_a_is_Some_True 
        by simp
    }
    hence "?s v = Some a".
  } note nb5 = this
  {
    fix v
    assume "v  dom (map_of ?pre)"
    then obtain a where "map_of ?pre v = Some a"
      by fast
    moreover have "(v, a)  set ?pre" 
      using map_of_SomeD calculation
      by fast
    moreover {
      have "op  set ((Ψ)𝒪+)" 
        using assms(4) nb3
        by blast
      then have "is_valid_operator_sas_plus Ψ op" 
        using is_valid_problem_sas_plus_then(2) assms(1)
        unfolding is_valid_operator_sas_plus_def
        by auto
      hence "(v, a)  set ?pre. (v', a')  set ?pre. v  v'  a = a'"
        using is_valid_operator_sas_plus_then(5)
        unfolding is_valid_operator_sas_plus_def
        by fast
    }
    moreover have "map_of ?pre v = Some a"
      using map_of_constant_assignments_defined_if[of ?pre] calculation(2, 3)
      by blast
    moreover obtain op' where "op'  set ops'" 
      and "(v, a)  set (strips_operator.precondition_of op')" 
      using nb4[OF assms(4) calculation(2)]
      by blast
    moreover have "?s v = Some a" 
      using nb5 calculation(5, 6) 
      by fast
    ultimately have "map_of ?pre v = ?s v"
      by argo
  }
  thus ?thesis 
    unfolding map_le_def
    by blast
qed

lemma to_sas_plus_list_of_transformed_sas_plus_problem_operators_structure:
  assumes "is_valid_problem_sas_plus Ψ"
    and "set ops'  set ((φ Ψ)𝒪)"
    and "op  set [φO¯ Ψ op'. op'  ops']" 
  shows "op  set ((Ψ)𝒪+)  (op'  set ops'. op' = φO Ψ op)"
proof - 
  let  = "φ Ψ"
  obtain op' where "op'  set ops'" and "op = φO¯ Ψ op'" 
    using assms(3) 
    by auto
  moreover have "op'  set (()𝒪)"
    using assms(2) calculation(1) 
    by blast
  moreover obtain op'' where "op''  set ((Ψ)𝒪+)" and "op' = φO Ψ op''" 
    using calculation(3) 
    by auto
  moreover have "op = op''" 
    using sas_plus_operator_inverse_is[OF assms(1) calculation(4)] calculation(2, 5) 
    by presburger
  ultimately show ?thesis 
    by blast
qed

(* ▪ TODO Prune premises (2nd premise and ‹are_all_operators_applicable s' ops'› can be removed?). 
   ▪ TODO make private. 
   ▪ TODO adjust nb indexes *)
lemma sas_plus_equivalent_to_strips_i_a_II:
  fixes Ψ :: "('variable, 'domain) sas_plus_problem"
  fixes s :: "('variable, 'domain) state" 
  assumes "is_valid_problem_sas_plus Ψ"
    and "set ops'  set ((φ Ψ)𝒪)"
    and "STRIPS_Semantics.are_all_operators_applicable (φs Ψ s) ops' 
       STRIPS_Semantics.are_all_operator_effects_consistent ops'"
  shows "are_all_operator_effects_consistent [φO¯ Ψ op'. op'  ops']" 
proof -
  let ?s' = "φS Ψ s"
  let ?s = "φS¯ Ψ ?s'"
    and ?ops = "[φO¯ Ψ op'. op'  ops']"
    and  = "φ Ψ"
  have nb: "(v, a)  dom ?s'. 
    (v, a')  dom ?s'. 
      ?s' (v, a) = Some True  ?s' (v, a') = Some True
       (v, a) = (v, a')" 
    using state_to_strips_state_effect_consistent[OF assms(1)] 
    by blast
  {
    fix op1' op2'
    assume "op1'  set ops'" and "op2'  set ops'"
    hence "STRIPS_Semantics.are_operator_effects_consistent op1' op2'" 
      using assms(3)
      unfolding STRIPS_Semantics.are_all_operator_effects_consistent_def list_all_iff
      by blast
  } note nb1 = this
  {
    fix op1 op1' op2 op2'
    assume op1_in_ops: "op1  set ?ops"
      and op1'_in_ops': "op1'  set ops'" 
      and op1'_is: "op1' = φO Ψ op1" 
      and is_valid_op1: "is_valid_operator_sas_plus Ψ op1"
      and op2_in_ops: "op2  set ?ops"
      and op2'_in_ops': "op2'  set ops'" 
      and op2'_is: "op2' = φO Ψ op2"
      and is_valid_op2: "is_valid_operator_sas_plus Ψ op2"
    have "(v, a)  set (add_effects_of op1'). (v', a')  set (add_effects_of op2').
          v  v'  a = a'" 
      proof (rule ccontr)
        assume "¬((v, a)  set (add_effects_of op1'). (v', a')  set (add_effects_of op2'). 
        v  v'  a = a')"
        then obtain v v' a a' where "(v, a)  set (add_effects_of op1')" 
          and "(v', a')  set (add_effects_of op2')" 
          and "v = v'" 
          and "a  a'" 
          by blast
        ― ‹ TODO slow. ›
        moreover have "(v, a)  set (effect_of op1)"  
          using op1'_is op2'_is calculation(1, 2)
          unfolding SAS_Plus_STRIPS.sasp_op_to_strips_def
            sasp_op_to_strips_def 
          by force
        moreover {
          have "(v', a')  set (effect_of op2)" 
            using op2'_is calculation(2) 
            unfolding SAS_Plus_STRIPS.sasp_op_to_strips_def
              sasp_op_to_strips_def
            by force
          hence "a'  + Ψ v"
            using is_valid_operator_sas_plus_then is_valid_op2 calculation(3)
            by fastforce
        }
        moreover have "(v, a')  set (delete_effects_of op1')" 
          using sasp_op_to_strips_set_delete_effects_is
            op1'_is is_valid_op1 calculation(3, 4, 5, 6)
          by blast
        moreover have "¬STRIPS_Semantics.are_operator_effects_consistent op1' op2'" 
          unfolding STRIPS_Semantics.are_operator_effects_consistent_def list_ex_iff 
          using calculation(2, 3, 7)
          by meson
        ultimately show False 
          using assms(3) op1'_in_ops' op2'_in_ops'
          unfolding STRIPS_Semantics.are_all_operator_effects_consistent_def list_all_iff
          by blast
      qed
  } note nb3 = this
  {
    fix op1 op2
    assume op1_in_ops: "op1  set ?ops" and op2_in_ops: "op2  set ?ops" 
    moreover have op1_in_operators_of_Ψ: "op1  set ((Ψ)𝒪+)" 
      and op2_in_operators_of_Ψ: "op2  set ((Ψ)𝒪+)" 
      using to_sas_plus_list_of_transformed_sas_plus_problem_operators_structure[OF 
          assms(1, 2)] calculation
      by blast+
    moreover have is_valid_operator_op1: "is_valid_operator_sas_plus Ψ op1" 
      and is_valid_operator_op2: "is_valid_operator_sas_plus Ψ op2" 
      using is_valid_problem_sas_plus_then(2) op1_in_operators_of_Ψ op2_in_operators_of_Ψ
        assms(1)
      unfolding is_valid_operator_sas_plus_def
      by auto+
    moreover obtain op1' op2' 
      where op1_in_ops': "op1'  set ops'" 
        and op1_is: "op1' = φO Ψ op1"
        and op2_in_ops': "op2'  set ops'"
        and op2_is: "op2' = φO Ψ op2"
      using to_sas_plus_list_of_transformed_sas_plus_problem_operators_structure[OF 
          assms(1, 2)] op1_in_ops op2_in_ops
      by blast
    ― ‹ TODO slow.›
    ultimately have "(v, a)  set (add_effects_of op1'). (v', a')  set (add_effects_of op2').
          v  v'  a = a'" 
      using nb3 
      by auto
    hence "are_operator_effects_consistent op1 op2"
      using op1_is op2_is 
      unfolding are_operator_effects_consistent_def
        sasp_op_to_strips_def 
        SAS_Plus_STRIPS.sasp_op_to_strips_def
        list_all_iff Let_def
      by simp
  }
  thus ?thesis 
    unfolding are_all_operator_effects_consistent_def list_all_iff 
    by fast
qed

― ‹ A technical lemmas used in sas_plus_equivalent_to_strips_i_a› showing that 
the execution precondition is linear w.r.t. to STRIPS transformation to SAS+. 

The second premise states that the given STRIPS state corresponds to a consistent SAS+ state (i.e.
no two assignments of the same variable to different values exist). ›
(* 
  ▪ TODO make private. 
  ▪ TODO decrement suffix *)
lemma sas_plus_equivalent_to_strips_i_a_IV: 
  assumes "is_valid_problem_sas_plus Ψ"
    and "set ops'  set ((φ Ψ)𝒪)"
    and "STRIPS_Semantics.are_all_operators_applicable (φS Ψ s) ops' 
       STRIPS_Semantics.are_all_operator_effects_consistent ops'"
  shows "are_all_operators_applicable_in (φS¯ Ψ (φS Ψ s)) [φO¯ Ψ op'. op'  ops'] 
    are_all_operator_effects_consistent [φO¯ Ψ op'. op'  ops']" 
proof -
  let  = "φ Ψ"
    and ?s' = "φS Ψ s"
  let ?vs' = "strips_problem.variables_of "
    and ?ops' = "strips_problem.operators_of " 
    and ?vs = "variables_of Ψ"
    and ?D = "range_of Ψ"
    and ?s = "φS¯ Ψ ?s'"
    and ?ops = "[φO¯ Ψ op'. op'  ops']"
  have nb: "(v, a)  dom ?s'. 
    (v, a')  dom (φS Ψ s). 
      ?s' (v, a) = Some True  ?s' (v, a') = Some True
       (v, a) = (v, a')" 
    using state_to_strips_state_effect_consistent[OF assms(1)] 
    by blast
  {
    have "STRIPS_Semantics.are_all_operators_applicable ?s' ops'" 
      using assms(3)
      by simp
    moreover have "list_all (λop. map_of (precondition_of op) m ?s) ?ops"
      using sas_plus_equivalent_to_strips_i_a_I[OF assms(1) assms(2)] calculation
      unfolding list_all_iff
      by blast
    moreover have "list_all (λop. list_all (are_operator_effects_consistent op) ?ops) ?ops" 
      using sas_plus_equivalent_to_strips_i_a_II assms nb
      unfolding are_all_operator_effects_consistent_def is_valid_operator_sas_plus_def list_all_iff 
      by blast
    ultimately have "are_all_operators_applicable_in ?s ?ops" 
      unfolding are_all_operators_applicable_in_def is_operator_applicable_in_def list_all_iff
      by argo
  }
  moreover have "are_all_operator_effects_consistent ?ops" 
    using sas_plus_equivalent_to_strips_i_a_II assms nb
    by simp
  ultimately show ?thesis
    by simp
qed

(* TODO:
  ▪ prune premises + make private. 
  ▪ decrement suffixes 
*)
lemma sas_plus_equivalent_to_strips_i_a_VI:
  assumes "is_valid_problem_sas_plus Ψ"
    and "dom s  set ((Ψ)𝒱+)"
    and "v  dom s. the (s v)  + Ψ v" 
    and "set ops'  set ((φ Ψ)𝒪)"
    and "are_all_operators_applicable_in s [φO¯ Ψ op'. op'  ops'] 
      are_all_operator_effects_consistent [φO¯ Ψ op'. op'  ops']"  
  shows "STRIPS_Semantics.are_all_operators_applicable (φS Ψ s) ops'"
proof -   
  let ?vs = "variables_of Ψ" 
    and ?D = "range_of Ψ"
    and  = "φ Ψ" 
    and ?ops = "[φO¯ Ψ op'. op'  ops']" 
    and ?s' = "φS Ψ s"
  ― ‹ TODO refactor. ›
  {
    fix op' 
    assume "op'  set ops'" 
    moreover obtain op where "op  set ?ops" and "op = φO¯ Ψ op'" 
      using calculation
      by force
    moreover obtain op'' where "op''  set ((Ψ)𝒪+)" and "op' = φO Ψ op''" 
      using assms(4) calculation(1) 
      by auto
    moreover have "is_valid_operator_sas_plus Ψ op''" 
      using is_valid_problem_sas_plus_then(2) assms(1) calculation(4)
      unfolding is_valid_operator_sas_plus_def
      by auto
    moreover have "op = op''" 
      using sas_plus_operator_inverse_is[OF assms(1)] calculation(3, 4, 5)
      by blast
    ultimately have "op  set ?ops. op  set ?ops  op = (φO¯ Ψ op') 
       is_valid_operator_sas_plus Ψ op"
      by blast
  } note nb1 = this
  have nb2: "(v, a)  dom ?s'. 
    (v, a')  dom ?s'. 
      ?s' (v, a) = Some True  ?s' (v, a') = Some True
       (v, a) = (v, a')" 
    using state_to_strips_state_effect_consistent[OF assms(1), of _ _ s]
    by blast
  {
    fix op
    assume "op  set ?ops" 
    hence "map_of (precondition_of op) m s" 
      using assms(5) 
      unfolding are_all_operators_applicable_in_def 
        is_operator_applicable_in_def list_all_iff
      by blast
  } note nb3 = this
  {
    fix op'
    assume "op'  set ops'" 
    then obtain op where op_in_ops: "op  set ?ops" 
      and op_is: "op = (φO¯ Ψ op')" 
      and is_valid_operator_op: "is_valid_operator_sas_plus Ψ op" 
      using nb1
      by force
    moreover have preconditions_are_consistent: 
      "(v, a)  set (precondition_of op). (v', a')  set (precondition_of op). v  v'  a = a'" 
      using is_valid_operator_sas_plus_then(5) calculation(3) 
      unfolding is_valid_operator_sas_plus_def
      by fast
    moreover {
      fix v a
      assume "(v, a)  set (strips_operator.precondition_of op')"
      moreover have v_a_in_precondition_of_op: "(v, a)  set (precondition_of op)" 
        using op_is calculation 
        unfolding SAS_Plus_STRIPS.strips_op_to_sasp_def
          strips_op_to_sasp_def
        by auto
      moreover have "map_of (precondition_of op) v = Some a" 
        using map_of_constant_assignments_defined_if[OF 
            preconditions_are_consistent calculation(2)]
        by blast
      moreover have s_of_v_is: "s v = Some a" 
        using nb3[OF op_in_ops] calculation(3) 
        unfolding map_le_def 
        by force
      moreover have "v  set ((Ψ)𝒱+)" and "a  + Ψ v" 
        using is_valid_operator_sas_plus_then(1, 2) is_valid_operator_op
          v_a_in_precondition_of_op 
        unfolding is_valid_operator_sas_plus_def 
          SAS_Plus_Representation.is_valid_operator_sas_plus_def Let_def list_all_iff ListMem_iff
        by auto+
      moreover have "(v, a)  dom ?s'" 
        using state_to_strips_state_dom_is[OF assms(1)] s_of_v_is 
        calculation 
        by simp
      moreover have "(φS¯ Ψ ?s') v = Some a" 
        using strips_state_to_state_inverse_is[OF assms(1, 2, 3)] s_of_v_is
        by argo
      ― ‹ TODO slow. ›
      ultimately have "?s' (v, a) = Some True" 
        using strips_state_to_state_range_is[OF assms(1)] nb2 
        by auto
    }
    ultimately have "(v, a)  set (strips_operator.precondition_of op'). ?s' (v, a) = Some True" 
      by fast
  }
  thus ?thesis 
    unfolding are_all_operators_applicable_def is_operator_applicable_in_def 
      STRIPS_Representation.is_operator_applicable_in_def list_all_iff
    by simp
qed

(* TODO Prune premises. *)
lemma sas_plus_equivalent_to_strips_i_a_VII:
  assumes "is_valid_problem_sas_plus Ψ"
    and "dom s  set ((Ψ)𝒱+)" 
    and "v  dom s. the (s v)  + Ψ v" 
    and "set ops'  set ((φ Ψ)𝒪)"
    and "are_all_operators_applicable_in s [φO¯ Ψ op'. op'  ops'] 
    are_all_operator_effects_consistent [φO¯ Ψ op'. op'  ops']"  
  shows "STRIPS_Semantics.are_all_operator_effects_consistent ops'"
proof - 
  let ?s' = "φS Ψ s" 
    and ?ops = "[φO¯ Ψ op'. op'  ops']"
    and ?D = "range_of Ψ"
    and  = "φ Ψ"
  ― ‹ TODO refactor. ›
  {
    fix op' 
    assume "op'  set ops'" 
    moreover obtain op where "op  set ?ops" and "op = φO¯ Ψ op'" 
      using calculation
      by force
    moreover obtain op'' where "op''  set ((Ψ)𝒪+)" and "op' = φO Ψ op''" 
      using assms(4) calculation(1) 
      by auto
    moreover have "is_valid_operator_sas_plus Ψ op''" 
      using is_valid_problem_sas_plus_then(2) assms(1) calculation(4)
      unfolding is_valid_operator_sas_plus_def
      by auto
    moreover have "op = op''" 
      using sas_plus_operator_inverse_is[OF assms(1)] calculation(3, 4, 5)
      by blast
    ultimately have "op  set ?ops. op  set ?ops  op' = (φO Ψ op)
       is_valid_operator_sas_plus Ψ op"
      by blast
  } note nb1 = this  
  {
    fix op1' op2'
    assume "op1'  set ops'" 
      and "op2'  set ops'" 
      and "(v, a)  set (add_effects_of op1'). (v', a')  set (delete_effects_of op2').
        (v, a) = (v', a')" 
    moreover obtain op1 op2
      where "op1  set ?ops" 
          and "op1' = φO Ψ op1" 
          and "is_valid_operator_sas_plus Ψ op1"
        and "op2  set ?ops" 
          and "op2' = φO Ψ op2" 
          and is_valid_op2: "is_valid_operator_sas_plus Ψ op2"
      using nb1 calculation(1, 2)
      by meson
    moreover obtain v v' a a' 
      where "(v, a)  set (add_effects_of op1')" 
        and "(v', a')  set (delete_effects_of op2')"
        and "(v, a) = (v', a')" 
      using calculation
      by blast
    moreover have "(v, a)  set (effect_of op1)" 
      using calculation(5, 10) 
      unfolding SAS_Plus_STRIPS.sasp_op_to_strips_def
        sasp_op_to_strips_def
      by fastforce
    moreover have "v = v'" and "a = a'"
      using calculation(12) 
      by simp+
    ― ‹ The next proof block shows that (v', a')› is constructed from an effect (v'', a'')›
      s.t. a' ≠ a''›.  ›
    moreover {
      (* TODO slow. *)
      have "(v', a')  ((v'', a'')  set (effect_of op2). 
        { (v'', a''') | a'''. a'''  (+ Ψ v'')   a'''  a'' })"
        using sasp_op_to_strips_set_delete_effects_is 
          calculation(8, 11) is_valid_op2 
        by blast
      then obtain v'' a'' where "(v'', a'')  set (effect_of op2)" 
        and "(v', a')  { (v'', a''') | a'''. a'''  (+ Ψ v'')   a'''  a'' }"
        by blast
      moreover have "(v', a'')  set (effect_of op2)" 
        using calculation 
        by blast
      moreover have "a'  + Ψ v''" and "a'  a''"
        using calculation(1, 2) 
        by fast+
      ultimately have "a''. (v', a'')  set (effect_of op2)  a'  (+ Ψ v') 
         a'  a''" 
        by blast
    }
    moreover obtain a'' where "(v', a'')  set (effect_of op2)" 
      and "a'  + Ψ v'"
      and "a'  a''"
      using calculation(16) 
      by blast
    moreover have "(v, a)  set (effect_of op1). ((v', a')  set (effect_of op2). 
      v = v'  a  a')"
      using calculation(13, 14, 15, 17, 19)
      by blast
    moreover have "¬are_operator_effects_consistent op1 op2"
      unfolding are_operator_effects_consistent_def list_all_iff
      using calculation(20)
      by fastforce
    ultimately have "¬are_all_operator_effects_consistent ?ops" 
      unfolding are_all_operator_effects_consistent_def list_all_iff
      by meson
  } note nb2 = this
  {
    fix op1' op2'
    assume op1'_in_ops: "op1'  set ops'" and op2'_in_ops: "op2'  set ops'" 
    have "STRIPS_Semantics.are_operator_effects_consistent op1' op2'"
      proof (rule ccontr)
        assume "¬STRIPS_Semantics.are_operator_effects_consistent op1' op2'"
        then consider (A) "(v, a)  set (add_effects_of op1'). 
          (v', a')  set (delete_effects_of op2'). (v, a) = (v', a')"
          | (B) "(v, a)  set (add_effects_of op2'). 
          (v', a')  set (delete_effects_of op1'). (v, a) = (v', a')"
          unfolding STRIPS_Semantics.are_operator_effects_consistent_def list_ex_iff
          by fastforce
        thus False 
          using nb2[OF op1'_in_ops op2'_in_ops] nb2[OF op2'_in_ops op1'_in_ops] assms(5)
          by (cases, argo, force)
      qed
  }
  thus ?thesis 
    unfolding STRIPS_Semantics.are_all_operator_effects_consistent_def 
      STRIPS_Semantics.are_operator_effects_consistent_def list_all_iff
    by blast
qed

lemma sas_plus_equivalent_to_strips_i_a_VIII:
  assumes "is_valid_problem_sas_plus Ψ"
    and "dom s  set ((Ψ)𝒱+)" 
    and "v  dom s. the (s v)  + Ψ v" 
    and "set ops'  set ((φ Ψ)𝒪)"
    and "are_all_operators_applicable_in s [φO¯ Ψ op'. op'  ops'] 
    are_all_operator_effects_consistent [φO¯ Ψ op'. op'  ops']"  
  shows "STRIPS_Semantics.are_all_operators_applicable (φS Ψ s) ops' 
     STRIPS_Semantics.are_all_operator_effects_consistent ops'"
  using sas_plus_equivalent_to_strips_i_a_VI sas_plus_equivalent_to_strips_i_a_VII assms
  by fastforce

(* TODO refactor. *)
lemma sas_plus_equivalent_to_strips_i_a_IX:
  assumes "dom s  V"
    and "op  set ops. (v, a)  set (effect_of op). v  V" 
  shows "dom (execute_parallel_operator_sas_plus s ops)  V"  
proof -
  show ?thesis 
    using assms
    proof (induction ops arbitrary: s)
      case Nil 
      then show ?case
        unfolding execute_parallel_operator_sas_plus_def
        by simp 
    next
      case (Cons op ops)
      let ?s' = "s ++ map_of (effect_of op)" 
      ― ‹ TODO Wrap IH instantiation in block. ›
      {
        have "(v, a)  set (effect_of op). v  V" 
          using Cons.prems(2)
          by fastforce
        moreover have "fst ` set (effect_of op)  V" 
          using calculation
          by fastforce
        ultimately have "dom ?s'  V" 
          unfolding dom_map_add dom_map_of_conv_image_fst
          using Cons.prems(1)
          by blast
      }
      moreover have "op  set ops. (v, a)  set (effect_of op). v  V"
        using Cons.prems(2)
        by fastforce
      ultimately have "dom (execute_parallel_operator_sas_plus ?s' ops)  V"
        using Cons.IH[of ?s']
        by fast
      thus ?case 
        unfolding execute_parallel_operator_sas_plus_cons.
    qed
qed

― ‹ NOTE Show that the domain value constraint on states is monotonous w.r.t. to valid operator 
execution. I.e. if a parallel operator is executed on a state for which the domain value constraint 
holds, the domain value constraint will also hold on the resultant state. ›
(* TODO refactor. 
  TODO Rewrite lemma without domain function, i.e. ‹set (the (D v)) ↝ D› *)
lemma sas_plus_equivalent_to_strips_i_a_X:
  assumes "dom s  V"
    and "V  dom D"
    and "v  dom s. the (s v)  set (the (D v))" 
    and "op  set ops. (v, a)  set (effect_of op). v  V  a  set (the (D v))" 
  shows "v  dom (execute_parallel_operator_sas_plus s ops). 
    the (execute_parallel_operator_sas_plus s ops v)  set (the (D v))"  
proof -
  show ?thesis 
    using assms
    proof (induction ops arbitrary: s)
      case Nil 
      then show ?case
        unfolding execute_parallel_operator_sas_plus_def
        by simp 
    next
      case (Cons op ops)
      let ?s' = "s ++ map_of (effect_of op)" 
      {
        {
          have "(v, a)  set (effect_of op). v  V" 
            using Cons.prems(4)
            by fastforce
          moreover have "fst ` set (effect_of op)  V" 
            using calculation
            by fastforce
          ultimately have "dom ?s'  V" 
            unfolding dom_map_add dom_map_of_conv_image_fst
            using Cons.prems(1)
            by blast
        }
        moreover {
          fix v
          assume v_in_dom_s': "v  dom ?s'"
          hence "the (?s' v)  set (the (D v))" 
            proof (cases "v  dom (map_of (effect_of op))")
              case True
              moreover have "?s' v = (map_of (effect_of op)) v"
                unfolding map_add_dom_app_simps(1)[OF True]
                by blast
              moreover obtain a where "(map_of (effect_of op)) v = Some a" 
                using calculation(1) 
                by fast
              moreover have "(v, a)  set (effect_of op)" 
                using map_of_SomeD calculation(3)
                by fast
              moreover have "a  set (the (D v))"
                using Cons.prems(4) calculation(4)
                by fastforce
              ultimately show ?thesis
                by force
            next
              case False
              then show ?thesis
                unfolding map_add_dom_app_simps(3)[OF False]
                using Cons.prems(3) v_in_dom_s'
                by fast
            qed
        }
        moreover have "op  set ops. (v, a)  set (effect_of op). v  V  a  set (the (D v))" 
          using Cons.prems(4)
          by auto
        ultimately have "v  dom (execute_parallel_operator_sas_plus ?s' ops).
          the (execute_parallel_operator_sas_plus ?s' ops v)  set (the (D v))" 
          using Cons.IH[of "s ++ map_of (effect_of op)", OF _ Cons.prems(2)]
          by meson
      }
      thus ?case 
        unfolding execute_parallel_operator_sas_plus_cons
        by blast
    qed
qed

lemma transfom_sas_plus_problem_to_strips_problem_operators_valid:
  assumes "is_valid_problem_sas_plus Ψ" 
    and "op'  set ((φ Ψ)𝒪)"
  obtains op 
  where "op  set ((Ψ)𝒪+)"
    and "op' = (φO Ψ op)" "is_valid_operator_sas_plus Ψ op" 
proof -
  {
    obtain op where "op  set ((Ψ)𝒪+)" and "op' = φO Ψ op" 
      using assms 
      by auto
    moreover have "is_valid_operator_sas_plus Ψ op" 
      using is_valid_problem_sas_plus_then(2) assms(1) calculation(1)
      by auto
    ultimately have "op  set ((Ψ)𝒪+). op' = (φO Ψ op)
       is_valid_operator_sas_plus Ψ op"
      by blast
  } 
  thus ?thesis 
    using that
    by blast
qed

lemma sas_plus_equivalent_to_strips_i_a_XI:
  assumes "is_valid_problem_sas_plus Ψ" 
    and "op'  set ((φ Ψ)𝒪)" 
  shows "(φS Ψ s) ++ map_of (effect_to_assignments op') 
    = φS Ψ (s ++ map_of (effect_of (φO¯ Ψ op')))"
proof -
  let  = "φ Ψ" 
  let ?vs = "variables_of Ψ"
    and?ops = "operators_of Ψ" 
    and ?ops' = "strips_problem.operators_of "
  let ?s' = "φS Ψ s"                 
  let ?t = "?s' ++ map_of (effect_to_assignments op')"
    and ?t' = "φS Ψ (s ++ map_of (effect_of (φO¯ Ψ op')))"
  obtain op where op'_is: "op' = (φO Ψ op)" 
    and op_in_ops: "op  set ((Ψ)𝒪+)" 
    and is_valid_operator_op: "is_valid_operator_sas_plus Ψ op"
    using transfom_sas_plus_problem_to_strips_problem_operators_valid[OF assms]
    by auto
  have nb1: "(φO¯ Ψ op') = op" 
    using sas_plus_operator_inverse_is[OF assms(1)] op'_is op_in_ops 
    by blast
  ― ‹ TODO refactor. ›
  {

    (*have "fst ` set (effect_to_assignments op') ≡
fst ` ((λv. (v, True)) ` set (add_effects_of op') ∪ (λv. (v, False)) ` set (delete_effects_of op'))"
      
      by auto
    then*) have "dom (map_of (effect_to_assignments op')) 
      = set (strips_operator.add_effects_of op')  set (strips_operator.delete_effects_of op')"
      unfolding dom_map_of_conv_image_fst
      by force
    ― ‹ TODO slow.›
    also have " = set (effect_of op)  set (strips_operator.delete_effects_of op')" 
      using op'_is 
      unfolding SAS_Plus_STRIPS.sasp_op_to_strips_def
        sasp_op_to_strips_def 
      by auto
    ― ‹ TODO slow.›
    finally have "dom (map_of (effect_to_assignments op')) = set (effect_of op)
       ((v, a)  set (effect_of op). { (v, a') | a'. a'  (+ Ψ v)  a'  a })" 
      using sasp_op_to_strips_set_delete_effects_is[OF 
          is_valid_operator_op] op'_is
      by argo
  } note nb2 = this
  have nb3: "dom ?t = dom ?s'  set (effect_of op)
     ((v, a)  set (effect_of op). { (v, a') | a'. a'  (+ Ψ v)  a'  a })" 
    unfolding nb2 dom_map_add
    by blast
  ― ‹ TODO refactor. ›
  have nb4: "dom (s ++ map_of (effect_of (φO¯ Ψ op'))) 
    = dom s  fst ` set (effect_of op)"
    unfolding dom_map_add dom_map_of_conv_image_fst nb1
    by fast
  {
    let ?u = "s ++ map_of (effect_of (φO¯ Ψ op'))"
    have "dom ?t' = (v  { v | v. v  set ((Ψ)𝒱+)  ?u v  None }. 
      { (v, a) | a. a  + Ψ v })" 
      using state_to_strips_state_dom_is[OF assms(1)]
      by presburger
  } note nb5 = this
  ― ‹ TODO refactor. ›
  have nb6: "set (add_effects_of op') = set (effect_of op)"
    using op'_is 
    unfolding SAS_Plus_STRIPS.sasp_op_to_strips_def
      sasp_op_to_strips_def
    by auto
  ― ‹ TODO refactor. ›
  have nb7: "set (delete_effects_of op') = ((v, a)  set (effect_of op). 
      { (v, a') | a'. a'  (+ Ψ v)  a'  a })" 
    using sasp_op_to_strips_set_delete_effects_is[OF 
        is_valid_operator_op] op'_is
    by argo
  ― ‹ TODO refactor. ›
  {
    let ?Add = "set (effect_of op)" 
    let ?Delete = "((v, a)  set (effect_of op). 
      { (v, a') | a'. a'  (+ Ψ v)  a'  a })" 
    have dom_add: "dom (map_of (map (λv. (v, True)) (add_effects_of op'))) = ?Add" 
      unfolding dom_map_of_conv_image_fst set_map image_comp comp_apply 
      using nb6
      by simp
    have dom_delete: "dom (map_of (map (λv. (v, False)) (delete_effects_of op'))) = ?Delete"
      unfolding dom_map_of_conv_image_fst set_map image_comp comp_apply 
      using nb7
      by auto
    {
      {
        fix v a 
        assume v_a_in_dom_add: "(v, a)  dom (map_of (map (λv. (v, True)) (add_effects_of op')))"
        have "(v, a)  dom (map_of (map (λv. (v, False)) (delete_effects_of op')))" 
          proof (rule ccontr) 
            assume "¬((v, a)  dom (map_of (map (λv. (v, False)) (delete_effects_of op'))))"
            then have "(v, a)  ?Delete" and "(v, a)  ?Add"
              using dom_add dom_delete v_a_in_dom_add
              by argo+   
            moreover have "(v', a')  ?Add. v  v'  a = a'"
              using is_valid_operator_sas_plus_then(6) is_valid_operator_op
                calculation(2)
              unfolding is_valid_operator_sas_plus_def
              by fast
            ultimately show False
              by fast
          qed
      }
      hence "disjnt (dom (map_of (map (λv. (v, True)) (add_effects_of op')))) 
        (dom (map_of (map (λv. (v, False)) (delete_effects_of op'))))"
        unfolding disjnt_def Int_def
        using nb7
        by simp
    }
    hence "dom (map_of (map (λv. (v, True)) (add_effects_of op'))) = ?Add"
      and "dom (map_of (map (λv. (v, False)) (delete_effects_of op'))) = ?Delete"
      and "disjnt (dom (map_of (map (λv. (v, True)) (add_effects_of op')))) 
        (dom (map_of (map (λv. (v, False)) (delete_effects_of op'))))" 
      using dom_add dom_delete
      by blast+
  } note nb8 = this
  ― ‹ TODO refactor. ›
  {
    let ?Add = "set (effect_of op)" 
    let ?Delete = "((v, a)  set (effect_of op). 
      { (v, a') | a'. a'  (+ Ψ v)  a'  a })" 
    ― ‹ TODO slow.›
    have "(v, a)  ?Add. map_of (effect_to_assignments op') (v, a) = Some True" 
      and "(v, a)  ?Delete. map_of (effect_to_assignments op') (v, a) = Some False"
      proof -
        {
          fix v a
          assume "(v, a)  ?Add" 
          hence "map_of (effect_to_assignments op') (v, a) = Some True"
            unfolding effect_to_assignments_simp
            using  nb6 map_of_defined_if_constructed_from_list_of_constant_assignments[of 
                "map (λv. (v, True)) (add_effects_of op')" True "add_effects_of op'"]
            by force
        }
        moreover {
          fix v a
          assume "(v, a)  ?Delete"
          moreover have "(v, a)  dom (map_of (map (λv. (v, False)) (delete_effects_of op')))"
            using nb8(2) calculation(1)
            by argo
          moreover have "(v, a)  dom (map_of (map (λv. (v, True)) (add_effects_of op')))" 
            using nb8
            unfolding disjnt_def 
            using calculation(1)
            by blast
          moreover have "map_of (effect_to_assignments op') (v, a) 
            = map_of (map (λv. (v, False)) (delete_effects_of op')) (v, a)"
            unfolding effect_to_assignments_simp map_of_append 
            using map_add_dom_app_simps(3)[OF calculation(3)]
            by presburger 
          ― ‹ TODO slow. ›
          ultimately have "map_of (effect_to_assignments op') (v, a) = Some False"
            using map_of_defined_if_constructed_from_list_of_constant_assignments[
                of "map (λv. (v, False)) (delete_effects_of op')" False "delete_effects_of op'"]
               nb7
            by auto
        }
        ultimately show "(v, a)  ?Add. map_of (effect_to_assignments op') (v, a) = Some True" 
          and "(v, a)  ?Delete. map_of (effect_to_assignments op') (v, a) = Some False" 
          by blast+
      qed
  } note nb9 = this
  {
    fix v a
    assume "(v, a)  set (effect_of op)"
    moreover have "(v, a)  set (effect_of op). (v', a')  set (effect_of op). v  v'  a = a'"
      using is_valid_operator_sas_plus_then is_valid_operator_op
      unfolding is_valid_operator_sas_plus_def
      by fast
    ultimately have "map_of (effect_of op) v = Some a" 
      using map_of_constant_assignments_defined_if[of "effect_of op"]
      by presburger
  } note nb10 = this
  {
    fix v a
    assume v_a_in_effect_of_op: "(v, a)  set (effect_of op)"
      and "(s ++ map_of (effect_of (φO¯ Ψ op'))) v  None"
    moreover have "v  set ?vs"
        using is_valid_operator_op is_valid_operator_sas_plus_then(3) calculation(1)
        by fastforce 
    moreover {
      have "is_valid_problem_strips "
        using is_valid_problem_sas_plus_then_strips_transformation_too 
          assms(1) 
        by blast
      thm calculation(1) nb6 assms(2)
      moreover have "set (add_effects_of op')  set (()𝒱)" 
        using assms(2) is_valid_problem_strips_operator_variable_sets(2)
          calculation 
        by blast
      moreover have "(v, a)  set (()𝒱)"
        using v_a_in_effect_of_op nb6 calculation(2) 
        by blast
      ultimately have "a  + Ψ v"
        using sas_plus_problem_to_strips_problem_variable_set_element_iff[OF 
            assms(1)]
        by fast
    }
    ― ‹ TODO slow. ›
    ultimately have "(v, a)  dom (φS Ψ (s ++ map_of (effect_of (φO¯ Ψ op'))))"  
      using state_to_strips_state_dom_is[OF assms(1), of 
          "s ++ map_of (effect_of (φO¯ Ψ op'))"]
      by simp
  } note nb11 = this
  {
    fix v a
    assume "(v, a)  set (effect_of op)"
    moreover have "v  dom (map_of (effect_of op))" 
      unfolding dom_map_of_conv_image_fst 
      using calculation
      by force 
    moreover have "(s ++ map_of (effect_of (φO¯ Ψ op'))) v = Some a" 
      unfolding map_add_dom_app_simps(1)[OF calculation(2)] nb1
      using nb10 calculation(1)
      by blast
    moreover have "(s ++ map_of (effect_of (φO¯ Ψ op'))) v  None" 
      using calculation(3)
      by auto
    moreover have "(v, a)  dom (φS Ψ (s ++ map_of (effect_of (φO¯ Ψ op'))))"
      using nb11 calculation(1, 4)
      by presburger
    ultimately have "(φS Ψ (s ++ map_of (effect_of (φO¯ Ψ op')))) (v, a) = Some True" 
      using state_to_strips_state_range_is[OF assms(1)]
      by simp
  } note nb12 = this
  {
    fix v a'
    assume "(v, a')  dom (map_of (effect_to_assignments op'))"   
      and "(v, a')   ((v, a)  set (effect_of op).
        { (v, a') | a'. a'  (+ Ψ v)  a'  a })"
    moreover have "v  dom (map_of (effect_of op))" 
      unfolding dom_map_of_conv_image_fst 
      using calculation(2)
      by force
    moreover have "v  set ?vs"
      using calculation(3) is_valid_operator_sas_plus_then(3) is_valid_operator_op
      unfolding dom_map_of_conv_image_fst is_valid_operator_sas_plus_def
      by fastforce
    moreover obtain a where "(v, a)  set (effect_of op)" 
      and "a'  + Ψ v" 
      and "a'  a" 
      using calculation(2)
      by blast
    moreover have "(s ++ map_of (effect_of (φO¯ Ψ op'))) v = Some a" 
      unfolding map_add_dom_app_simps(1)[OF calculation(3)] nb1
      using nb10 calculation(5)
      by blast
    moreover have "(s ++ map_of (effect_of (φO¯ Ψ op'))) v  None" 
      using calculation(8) 
      by auto
    ― ‹ TODO slow. ›
    moreover have "(v, a')  dom (φS Ψ (s ++ map_of (effect_of (φO¯ Ψ op'))))"
      using state_to_strips_state_dom_is[OF assms(1), of 
        "s ++ map_of (effect_of (φO¯ Ψ op'))"] calculation(4, 6, 9)
      by simp
    ― ‹ TODO slow. ›
    ultimately have "(φS Ψ (s ++ map_of (effect_of (φO¯ Ψ op')))) (v, a') = Some False" 
      using state_to_strips_state_range_is[OF assms(1), 
          of v a' "s ++ map_of (effect_of (φO¯ Ψ op'))"]
      by simp
  } note nb13 = this
  {
    fix v a
    assume "(v, a)  dom ?t" 
      and "(v, a)  dom (map_of (effect_to_assignments op'))"
    moreover have "(v, a)  dom ?s'" 
      using calculation(1, 2)
      unfolding dom_map_add
      by blast
    moreover have "?t (v, a) = ?s' (v, a)" 
      unfolding map_add_dom_app_simps(3)[OF calculation(2)]..
    ultimately have "?t (v, a) = Some (the (s v) = a)"
      using state_to_strips_state_range_is[OF assms(1)] 
      by presburger
  } note nb14 = this
  {
    fix v a
    assume "(v, a)  dom ?t" 
      and v_a_not_in: "(v, a)  dom (map_of (effect_to_assignments op'))"
    moreover have "(v, a)  dom ?s'" 
      using calculation(1, 2)
      unfolding dom_map_add
      by blast
    moreover have "(v, a)  ( v  { v | v. v  set ((Ψ)𝒱+)  s v  None }.
      { (v, a) | a. a  + Ψ v })"
      using state_to_strips_state_dom_is[OF assms(1)] calculation(3)
      by presburger
    moreover have "v  set ((Ψ)𝒱+)" and "s v  None" and "a  + Ψ v" 
      using calculation(4)
      by blast+
    ― ‹ NOTE Hasn't this been proved before? ›
    moreover {
      have "dom (map_of (effect_to_assignments op')) = ((v, a)  set (effect_of op). { (v, a) }) 
         ((v, a)  set (effect_of op). 
          { (v, a') | a'. a'  (+ Ψ v)  a'  a })"
        unfolding nb2
        by blast
      also have " = ((v, a)  set (effect_of op). { (v, a) } 
           { (v, a') | a'. a'  (+ Ψ v)  a'  a })" 
        by blast
      finally have "dom (map_of (effect_to_assignments op')) 
        = ((v, a)  set (effect_of op). { (v, a) } 
           { (v, a) | a. a  + Ψ v })"
        by auto
      then have "(v, a)  ((v, a)  set (effect_of op). 
        { (v, a) | a. a  + Ψ v })" 
        using v_a_not_in
        by blast
    }
    ― ‹ TODO slow. ›
    moreover have "v  dom (map_of (effect_of op))" 
      using dom_map_of_conv_image_fst calculation 
      by fastforce
    moreover have "(s ++ map_of (effect_of (φO¯ Ψ op'))) v = s v" 
      unfolding nb1 map_add_dom_app_simps(3)[OF calculation(9)]
      by simp
    ― ‹ TODO slow. ›
    moreover have "(v, a)  dom ?t'" 
      using state_to_strips_state_dom_is[OF assms(1), of 
        "s ++ map_of (effect_of (φO¯ Ψ op'))"] calculation(5, 6, 7, 8, 10)
      by simp
    ultimately have "?t' (v, a) = Some (the (s v) = a)" 
      using state_to_strips_state_range_is[OF assms(1)]
      by presburger
  } note nb15 = this
  ― ‹ TODO refactor. ›
  have nb16: "dom ?t = ( v  { v | v. v  set ((Ψ)𝒱+)  s v  None }. 
      { (v, a) | a. a  (+ Ψ v) }) 
     set (effect_of op) 
     ((v, a)set (effect_of op).
      {(v, a') |a'. a'  (+ Ψ v)  a'  a})"
    unfolding dom_map_add nb2
    using state_to_strips_state_dom_is[OF assms(1), of s]
    by auto
  {
    {
      fix v a
      assume "(v, a)  dom ?t"
      then consider (A) "(v, a)  dom (φS Ψ s)" 
        | (B) "(v, a)  dom (map_of (effect_to_assignments op'))" 
        by fast
      hence "(v, a)  dom ?t'" 
        proof (cases)
          case A
          then have "v  set ((Ψ)𝒱+)" and "s v  None" and "a  + Ψ v"
            unfolding state_to_strips_state_dom_element_iff[OF assms(1)]
            by blast+
          thm map_add_None state_to_strips_state_dom_element_iff[OF assms(1)]
          moreover have "(s ++ map_of (effect_of (φO¯ Ψ op'))) v  None" 
            using calculation(2)
            by simp
          ultimately show ?thesis 
            unfolding state_to_strips_state_dom_element_iff[OF assms(1)]
            by blast
        next
          case B
          then have "(v, a)  
              set (effect_of op) 
               ((v, a)set (effect_of op). { (v, a') | a'. a'  + Ψ v  a'  a })" 
            unfolding nb2
            by blast
          then consider (B1) "(v, a)  set (effect_of op)" 
            | (B2) "(v, a)  ((v, a)set (effect_of op). 
            { (v, a') | a'. a'  + Ψ v  a'  a })"
            by blast
          thm nb12 nb13 nb2
          thus ?thesis
            proof (cases)
              case B1
              then show ?thesis
                using nb12
                by fast
            next
              case B2
              then show ?thesis
                using nb13 B
                by blast
            qed 
        qed 
    } 
    moreover {
      let ?u = "s ++ map_of (effect_of (φO¯ Ψ op'))"
      fix v a
      assume v_a_in_dom_t': "(v, a)  dom ?t'"
      thm nb5
      then have v_in_vs: "v  set ((Ψ)𝒱+)" 
        and u_of_v_is_not_None: "?u v  None" 
        and a_in_range_of_v: "a  + Ψ v" 
        using state_to_strips_state_dom_element_iff[OF assms(1)]
          v_a_in_dom_t'
        by meson+
      {
        assume "(v, a)  dom ?t" 
        then have contradiction: "(v, a)  
          (v  { v | v. v  set ((Ψ)𝒱+)  s v  None}. { (v, a) |a. a  + Ψ v }) 
           set (effect_of op) 
           ((v, a)set (effect_of op). {(v, a') |a'. a'  + Ψ v  a'  a})" 
          unfolding nb16
          by fast
        hence False 
          proof (cases "map_of (effect_of (φO¯ Ψ op')) v = None")
            case True
            then have "s v  None" 
              using u_of_v_is_not_None
              by simp
            then have "(v, a)  (v  { v | v. v  set ((Ψ)𝒱+)  s v  None}. 
              { (v, a) |a. a  + Ψ v })" 
              using v_in_vs a_in_range_of_v 
              by blast
            thus ?thesis 
              using contradiction
              by blast
          next
            case False
            then have "v  dom (map_of (effect_of op))" 
              using u_of_v_is_not_None nb1 
              by blast
            then obtain a' where map_of_effect_of_op_v_is: "map_of (effect_of op) v = Some a'" 
              by blast
            then have v_a'_in: "(v, a')  set (effect_of op)" 
              using map_of_SomeD 
              by fast
            then show ?thesis
              proof (cases "a = a'")
                case True
                then have "(v, a)  set (effect_of op)" 
                  using v_a'_in
                  by blast
                then show ?thesis 
                  using contradiction
                  by blast
              next
                case False
                then have "(v, a)  ((v, a)set (effect_of op). 
                  {(v, a') |a'. a'  + Ψ v  a'  a})" 
                  using v_a'_in calculation a_in_range_of_v
                  by blast
                thus ?thesis
                  using contradiction
                  by fast
              qed
          qed
      }
      hence "(v, a)  dom ?t"
        by argo
    }
    moreover have "dom ?t  dom ?t'" and "dom ?t'  dom ?t" 
      subgoal 
        using calculation(1) subrelI[of "dom ?t" "dom ?t'"]
        by fast
      subgoal
        using calculation(2) subrelI[of "dom ?t'" "dom ?t"]
        by argo
      done
    ultimately have "dom ?t = dom ?t'"
      by force
  } note nb17 = this
  {
    fix v a
    assume v_a_in_dom_t: "(v, a)  dom ?t" 
    hence "?t (v, a) = ?t' (v, a)"
      proof (cases "(v, a)  dom (map_of (effect_to_assignments op'))")
        case True
        ― ‹ TODO slow. ›
        ― ‹ NOTE Split on the (disjunct) domain variable sets of 
          @{text "map_of (effect_to_assignments op')"}. › 
        then consider (A1) "(v, a)  set (effect_of op)" 
          | (A2) "(v, a)  ((v, a)  set (effect_of op).
            { (v, a') | a'. a'  (+ Ψ v)  a'  a })"
          using nb2
          by fastforce
        then show ?thesis 
          proof (cases)
            case A1
            then have "?t (v, a) = Some True" 
              unfolding map_add_dom_app_simps(1)[OF True]
              using nb9(1)
              by fast
            moreover have "?t' (v, a) = Some True"
              using nb12[OF A1].
            ultimately show ?thesis..
          next
            case A2
            then have "?t (v, a) = Some False" 
              unfolding map_add_dom_app_simps(1)[OF True]
              using nb9(2)
              by blast
            moreover have "?t' (v, a) = Some False"
              using nb13[OF True A2].
            ultimately show ?thesis..
          qed
      next
        case False
        moreover have "?t (v, a) = Some (the (s v) = a)" 
          using nb14[OF v_a_in_dom_t False].
        moreover have "?t' (v, a) = Some (the (s v) = a)" 
          using nb15[OF v_a_in_dom_t False].
        ultimately show ?thesis 
          by argo
      qed
  } note nb18 = this
  moreover {
    fix v a
    assume "(v, a)  dom ?t'" 
    hence "?t (v, a) = ?t' (v, a)" 
      using nb17 nb18
      by presburger
  }
  ― ‹ TODO slow.›
  ultimately have "?t m ?t'" and "?t' m ?t" 
    unfolding map_le_def 
    by fastforce+
  thus ?thesis
    using map_le_antisym[of ?t ?t'] 
    by fast
qed

― ‹ NOTE This is the essential step in the SAS+/STRIPS equivalence theorem. We show that executing
a given parallel STRIPS operator @{text "ops'"} on the corresponding STRIPS state 
@{text "s' = φS Ψ s"} yields the same state as executing the transformed SAS+ parallel operator
@{text "ops = [φO¯ (φ Ψ) op'. op' ← ops']"} on the original SAS+ state @{text "s"} and the 
transforming the resultant SAS+ state to its corresponding STRIPS state. ›
(* TODO refactor. *)
lemma sas_plus_equivalent_to_strips_i_a_XII:
  assumes "is_valid_problem_sas_plus Ψ" 
    and "op'  set ops'. op'  set ((φ Ψ)𝒪)" 
  shows "execute_parallel_operator (φS Ψ s) ops' 
    = φS Ψ (execute_parallel_operator_sas_plus s [φO¯ Ψ op'. op'  ops'])" 
using assms
proof (induction ops' arbitrary: s)
  case Nil
  then show ?case 
    unfolding execute_parallel_operator_def execute_parallel_operator_sas_plus_def 
    by simp
next
  case (Cons op' ops')
  let  = "φ Ψ"
  let ?t' = "(φS Ψ s) ++ map_of (effect_to_assignments op')"
    and ?t = "s ++ map_of (effect_of (φO¯ Ψ op'))"
  have nb1: "?t' = φS Ψ ?t" 
    using sas_plus_equivalent_to_strips_i_a_XI[OF assms(1)] Cons.prems(2)
    by force
  {
    have "op'  set ops'. op'  set (strips_problem.operators_of )" 
      using Cons.prems(2) 
      by simp
    then have "execute_parallel_operator (φS Ψ ?t) ops' 
      = φS Ψ (execute_parallel_operator_sas_plus ?t [φO¯ Ψ x. x  ops'])"
      using Cons.IH[OF Cons.prems(1), of ?t]
      by fastforce
    hence "execute_parallel_operator ?t' ops'
      = φS Ψ (execute_parallel_operator_sas_plus ?t [φO¯ Ψ x. x  ops'])" 
      using nb1
      by argo
  }
  thus ?case 
    by simp
qed

lemma sas_plus_equivalent_to_strips_i_a_XIII: 
  assumes "is_valid_problem_sas_plus Ψ"
    and "op'  set ops'. op'  set ((φ Ψ)𝒪)"
    and "(φS Ψ G) m execute_parallel_plan 
      (execute_parallel_operator (φS Ψ I) ops') π"
  shows "(φS Ψ G) m execute_parallel_plan 
    (φS Ψ (execute_parallel_operator_sas_plus I [φO¯ Ψ op'. op'  ops'])) π"
proof -
  let ?I' = "(φS Ψ I)"
    and ?G' = "φS Ψ G" 
    and ?ops = "[φO¯ Ψ op'. op'  ops']" 
    and  = "φ Ψ"
  let ?J = "execute_parallel_operator_sas_plus I ?ops"
  {
    fix v a
    assume "(v, a)  dom ?G'"
    then have "?G' (v, a) = execute_parallel_plan 
      (execute_parallel_operator ?I' ops') π (v, a)"
      using assms(3) 
      unfolding map_le_def
      by auto
    hence "?G' (v, a) = execute_parallel_plan (φS Ψ ?J) π (v, a)" 
      using sas_plus_equivalent_to_strips_i_a_XII[OF assms(1, 2)]
      by simp
  }
  thus ?thesis 
    unfolding map_le_def
    by fast
qed

― ‹ NOTE This is a more abstract formulation of the proposition in 
sas_plus_equivalent_to_strips_i› which is better suited for induction proofs. We essentially claim 
that given a plan the execution in STRIPS semantics of which solves the problem of reaching a 
transformed goal state φS Ψ G› from a transformed initial state φS Ψ I›—such as 
the goal and initial state of an induced STRIPS problem for a SAS+ problem—is equivalent to an
execution in SAS+ semantics of the transformed plan φP¯ (φ Ψ) π› w.r.t to the original 
initial state I› and original goal state G›. › 
lemma sas_plus_equivalent_to_strips_i_a:
  assumes "is_valid_problem_sas_plus Ψ" 
    and "dom I  set ((Ψ)𝒱+)"
    and "v  dom I. the (I v)  + Ψ v" 
    and "dom G  set ((Ψ)𝒱+)" 
    and "v  dom G. the (G v)  + Ψ v" 
    and "ops'  set π. op'  set ops'. op'  set ((φ Ψ)𝒪)"
    and "(φS Ψ G) m execute_parallel_plan (φS Ψ I) π"
  shows "G m execute_parallel_plan_sas_plus I (φP¯ Ψ π)"
proof -
  let ?vs = "variables_of Ψ"
    and  = "φP¯ Ψ π"
  show ?thesis 
    using assms
    proof (induction π arbitrary: I)
      case Nil
      then have "(φS Ψ G) m (φS Ψ I)" 
        by fastforce
      then have "G m I" 
        using state_to_strips_state_map_le_iff[OF assms(1, 4, 5)]
        by blast
      thus ?case 
        unfolding SAS_Plus_STRIPS.strips_parallel_plan_to_sas_plus_parallel_plan_def
          strips_parallel_plan_to_sas_plus_parallel_plan_def 
        by fastforce
    next
      case (Cons ops' π)
      let ?D = "range_of Ψ"
        and  = "φ Ψ" 
        and ?I' = "φS Ψ I"
        and ?G' = "φS Ψ G"
      let ?ops = "[φO¯ Ψ op'. op'  ops']" 
      let ?J = "execute_parallel_operator_sas_plus I ?ops"
        and ?J' = "execute_parallel_operator ?I' ops'" 
      have nb1: "set ops'  set (()𝒪)" 
        using Cons.prems(6)
        unfolding STRIPS_Semantics.is_parallel_solution_for_problem_def list_all_iff ListMem_iff
        by fastforce
      {
        fix op 
        assume "op  set ?ops" 
        moreover obtain op' where "op'  set ops'" and "op = φO¯ Ψ op'" 
          using calculation 
          by auto
        moreover have "op'  set (()𝒪)"
          using nb1 calculation(2)
          by blast
        moreover obtain op'' where "op''  set ((Ψ)𝒪+)" and "op' = φO Ψ op''" 
          using calculation(4) 
          by auto
        moreover have "op = op''" 
          using sas_plus_operator_inverse_is[OF assms(1) calculation(5)] calculation(3, 6) 
          by presburger
        ultimately have "op  set ((Ψ)𝒪+)  (op'  set ops'. op' = φO Ψ op)" 
          by blast
      } note nb2 = this
      {
        fix op v a
        assume "op  set ((Ψ)𝒪+)" and "(v, a)  set (effect_of op)" 
        moreover have "op  set ((Ψ)𝒪+)" 
          using nb2 calculation(1)
          by blast
        moreover have "is_valid_operator_sas_plus Ψ op"
          using is_valid_problem_sas_plus_then(2) Cons.prems(1) calculation(3) 
          by blast
        ultimately have "v  set ((Ψ)𝒱+)"
          using is_valid_operator_sas_plus_then(3) 
          by fastforce
      } note nb3 = this
      {
        fix op
        assume "op  set ?ops" 
        then have "op  set ((Ψ)𝒪+)" 
          using nb2 
          by blast
        then have "is_valid_operator_sas_plus Ψ op"
          using is_valid_problem_sas_plus_then(2) Cons.prems(1)
          by blast
        hence "(v, a)  set (effect_of op). v  set ((Ψ)𝒱+) 
           a  + Ψ v"
          using is_valid_operator_sas_plus_then(3,4) 
          by fast
      } note nb4 = this
      show ?case 
        proof (cases "STRIPS_Semantics.are_all_operators_applicable ?I' ops' 
           STRIPS_Semantics.are_all_operator_effects_consistent ops'")
          case True
          {
            {
              have "dom I  set ((Ψ)𝒱+)" 
                using Cons.prems(2)
                by blast
              hence "(φS¯ Ψ ?I') = I"
                using strips_state_to_state_inverse_is[OF 
                    Cons.prems(1) _ Cons.prems(3)]
                by argo
            }
            then have "are_all_operators_applicable_in I ?ops
               are_all_operator_effects_consistent ?ops" 
              using sas_plus_equivalent_to_strips_i_a_IV[OF assms(1) nb1, of I] True
              by simp
            moreover have "(φP¯ Ψ (ops' # π)) = ?ops # (φP¯ Ψ π)" 
              unfolding SAS_Plus_STRIPS.strips_parallel_plan_to_sas_plus_parallel_plan_def
                strips_parallel_plan_to_sas_plus_parallel_plan_def
                SAS_Plus_STRIPS.strips_op_to_sasp_def
                  strips_op_to_sasp_def  
              by simp
            ultimately have "execute_parallel_plan_sas_plus I (φP¯ Ψ (ops' # π)) 
              = execute_parallel_plan_sas_plus ?J (φP¯ Ψ π)" 
              by force
          } note nb5 = this
          ― ‹ Show the goal using the IH. ›
          {
            have dom_J_subset_eq_vs: "dom ?J  set ((Ψ)𝒱+)"
              using sas_plus_equivalent_to_strips_i_a_IX[OF Cons.prems(2)] nb2 nb4
              by blast
            moreover {
              have "set ((Ψ)𝒱+)  dom (range_of Ψ)"
                using is_valid_problem_sas_plus_then(1)[OF assms(1)]
                by fastforce
              moreover have "v  dom I. the (I v)  set (the (range_of Ψ v))"
                using Cons.prems(2, 3) assms(1) set_the_range_of_is_range_of_sas_plus_if 
                by force
              moreover have "op  set ?ops. (v, a)  set (effect_of op).
                v  set ((Ψ)𝒱+)  a  set (the (?D v))" 
                using set_the_range_of_is_range_of_sas_plus_if assms(1) nb4 
                by fastforce
              moreover have v_in_dom_J_range: "v  dom ?J. the (?J v)  set (the (?D v))" 
                using sas_plus_equivalent_to_strips_i_a_X[of 
                    I "set ((Ψ)𝒱+)" ?D ?ops, OF Cons.prems(2)] calculation(1, 2, 3)
                by fastforce
              {
                fix v 
                assume "v  dom ?J"
                moreover have "v  set ((Ψ)𝒱+)"
                  using nb2 calculation dom_J_subset_eq_vs 
                  by blast
                moreover have "set (the (range_of Ψ v)) = + Ψ v" 
                  using set_the_range_of_is_range_of_sas_plus_if[OF assms(1)] 
                    calculation(2)
                  by presburger
                ultimately have "the (?J v)  + Ψ v" 
                  using nb3 v_in_dom_J_range
                  by blast
              }
              ultimately have "v  dom ?J. the (?J v)  + Ψ v"
                by fast
            }
            moreover have "ops'  set π. op'set ops'. op'  set ((φ Ψ)𝒪)"
              using Cons.prems(6)
              by simp
            moreover {
              have "?G' m execute_parallel_plan ?J' π" 
                using Cons.prems(7) True
                by auto
              hence "(φS Ψ G) m execute_parallel_plan (φS Ψ ?J) π"
                using sas_plus_equivalent_to_strips_i_a_XIII[OF Cons.prems(1)] nb1
                by blast
            }
            ultimately have "G m execute_parallel_plan_sas_plus I (φP¯ Ψ (ops' # π))"
              using Cons.IH[of ?J, OF Cons.prems(1) _ _ Cons.prems(4, 5)] Cons.prems(6) nb5 
              by presburger
          }
          thus ?thesis.
        next
          case False
          then have "?G' m ?I'" 
            using Cons.prems(7)
            by force
          moreover {
            have "dom I  set ?vs" 
              using Cons.prems(2)
              by simp
            hence "¬(are_all_operators_applicable_in I ?ops
               are_all_operator_effects_consistent ?ops)" 
              using sas_plus_equivalent_to_strips_i_a_VIII[OF Cons.prems(1) _ Cons.prems(3) nb1] 
                False
              by force
          }
          moreover {
            have "(φP¯ Ψ (ops' # π)) = ?ops # (φP¯ Ψ π)" 
              unfolding SAS_Plus_STRIPS.strips_parallel_plan_to_sas_plus_parallel_plan_def
                strips_parallel_plan_to_sas_plus_parallel_plan_def
                SAS_Plus_STRIPS.strips_op_to_sasp_def
                strips_op_to_sasp_def
              by simp
            hence "G m execute_parallel_plan_sas_plus I (?ops # (φP¯ Ψ π))
               G m I" 
              using calculation(2)
              by force
          }
          ultimately show ?thesis 
            using state_to_strips_state_map_le_iff[OF Cons.prems(1, 4, 5)] 
            unfolding SAS_Plus_STRIPS.strips_parallel_plan_to_sas_plus_parallel_plan_def
              strips_parallel_plan_to_sas_plus_parallel_plan_def
              SAS_Plus_STRIPS.strips_op_to_sasp_def
              strips_op_to_sasp_def
            by force
        qed
    qed
qed

― ‹ NOTE Show that a solution for the induced STRIPS problem for the given valid SAS+ problem, 
  corresponds to a solution for the given SAS+ problem.

Note that in the context of the SAS+ problem solving pipeline, we
\begin{enumerate}
  \item convert the given valid SAS+ @{text "Ψ"} problem to the corresponding STRIPS problem 
@{text "Π"} (this is implicitely also valid by lemma 
@{text "is_valid_problem_sas_plus_then_strips_transformation_too"}); then,
  \item get a solution @{text "π"}—if it exists—for the induced STRIPS problem by executing 
SATPlan; and finally,
  \item convert @{text "π"} back to a solution @{text "ψ"} for the SAS+ problem.
\end{enumerate} ›
lemma sas_plus_equivalent_to_strips_i:
  assumes "is_valid_problem_sas_plus Ψ" 
    and "STRIPS_Semantics.is_parallel_solution_for_problem 
    (φ Ψ) π"
  shows "goal_of Ψ m execute_parallel_plan_sas_plus 
    (sas_plus_problem.initial_of Ψ) (φP¯ Ψ π)"
proof -
  let ?vs = "variables_of Ψ"
    and ?I = "initial_of Ψ" 
    and ?G = "goal_of Ψ"
  let  = "φ Ψ"
  let ?G' = "strips_problem.goal_of "
    and ?I' = "strips_problem.initial_of "
  let  = "φP¯ Ψ π"
  have "dom ?I  set ?vs" 
    using is_valid_problem_sas_plus_then(3) assms(1)
    by auto
  moreover have "v  dom ?I. the (?I v)  + Ψ v" 
    using is_valid_problem_sas_plus_then(4) assms(1) calculation
    by auto
  moreover have "dom ?G  set ?vs"  and "v  dom ?G. the (?G v)  + Ψ v" 
    using is_valid_problem_sas_plus_then(5, 6) assms(1)
    by blast+
  moreover have "ops'set π. op'set ops'. op'  set (()𝒪)"
    using is_parallel_solution_for_problem_operator_set[OF assms(2)]
    by simp
  moreover {
    have "?G' m execute_parallel_plan ?I' π"
      using assms(2) 
      unfolding STRIPS_Semantics.is_parallel_solution_for_problem_def..
    moreover have "?G' = φS Ψ ?G" and "?I' = φS Ψ ?I" 
      by simp+
    ultimately have "(φS Ψ ?G) m execute_parallel_plan (φS Ψ ?I) π"
      by simp
  }
  ultimately show ?thesis 
    using sas_plus_equivalent_to_strips_i_a[OF assms(1)]
    by simp
qed

― ‹ NOTE Show that the operators for a given solution @{text "π"} to the induced STRIPS problem 
for a given SAS+ problem correspond to operators of the SAS+ problem. ›
lemma sas_plus_equivalent_to_strips_ii:
  assumes "is_valid_problem_sas_plus Ψ" 
    and "STRIPS_Semantics.is_parallel_solution_for_problem (φ Ψ) π"
  shows "list_all (list_all (λop. ListMem op (operators_of Ψ))) (φP¯ Ψ π)" 
proof -
  let  = "φ Ψ" 
  let ?ops = "operators_of Ψ" 
    and  = "φP¯ Ψ π"
  have "is_valid_problem_strips " 
    using is_valid_problem_sas_plus_then_strips_transformation_too[OF assms(1)]
    by simp 
  have nb1: "op'  set (()𝒪). (op  set ?ops. op' = (φO Ψ op))"  
    by auto
  {
    fix ops' op' op
    assume "ops'  set π" and "op'  set ops'" 
    then have "op'  set (strips_problem.operators_of )"
      using is_parallel_solution_for_problem_operator_set[OF assms(2)]
      by simp
    then obtain op where "op  set ((Ψ)𝒪+)" and "op' = (φO Ψ op)" 
      by auto
    then have "(φO¯ Ψ op')  set ((Ψ)𝒪+)"
      using sas_plus_operator_inverse_is[OF assms(1)]
      by presburger
  }
  thus ?thesis 
    unfolding list_all_iff ListMem_iff 
      strips_parallel_plan_to_sas_plus_parallel_plan_def
      SAS_Plus_STRIPS.strips_parallel_plan_to_sas_plus_parallel_plan_def
      SAS_Plus_STRIPS.strips_op_to_sasp_def
      strips_op_to_sasp_def
    by auto
qed

text ‹ We now show that for a parallel solution termπ of termΠ the SAS+ plan 
termψ  φP¯ Ψ π yielded by the STRIPS to SAS+ plan transformation is a solution for 
termΨ. The proof uses the definition of parallel STRIPS solutions and shows that the 
execution of termψ on the initial state of the SAS+ problem yields a state satisfying the 
problem's goal state, i.e.
  @{text[display, indent=4]"G ⊆m execute_parallel_plan_sas_plus I ψ"}
and by showing that all operators in all parallel operators of termψ are operators of the 
problem. ›

theorem
  sas_plus_equivalent_to_strips:
  assumes "is_valid_problem_sas_plus Ψ"
    and "STRIPS_Semantics.is_parallel_solution_for_problem (φ Ψ) π" 
  shows "is_parallel_solution_for_problem Ψ (φP¯ Ψ π)"
proof -
  let ?I = "initial_of Ψ"
    and ?G = "goal_of Ψ" 
    and ?ops = "operators_of Ψ"
    and  = "φP¯ Ψ π"
  show ?thesis
    unfolding is_parallel_solution_for_problem_def Let_def
    proof (rule conjI)
      show "?G m execute_parallel_plan_sas_plus ?I "
        using sas_plus_equivalent_to_strips_i[OF assms].
    next 
      show "list_all (list_all (λop. ListMem op ?ops)) " 
        using sas_plus_equivalent_to_strips_ii[OF assms].
    qed
qed

private lemma strips_equivalent_to_sas_plus_i_a_I:
  assumes "is_valid_problem_sas_plus Ψ"
    and "op  set ops. op  set ((Ψ)𝒪+)" 
    and "op'  set [φO Ψ op. op  ops]"
  obtains op where "op  set ops" 
    and "op' = φO Ψ op"
proof -
  let  = "φ Ψ" 
  let ?ops = "operators_of Ψ"
  obtain op where "op  set ops" and "op' = φO Ψ op" 
    using assms(3) 
    by auto
  thus ?thesis 
    using that
    by blast
qed

private corollary strips_equivalent_to_sas_plus_i_a_II:
  assumes"is_valid_problem_sas_plus Ψ"
    and "op  set ops. op  set ((Ψ)𝒪+)" 
    and "op'  set [φO Ψ op. op  ops]"
  shows "op'  set ((φ Ψ)𝒪)"
    and "is_valid_operator_strips (φ Ψ) op'"
proof -
  let  = "φ Ψ" 
  let ?ops = "operators_of Ψ"
    and ?ops' = "strips_problem.operators_of "
  obtain op where op_in: "op  set ops" and op'_is: "op' = φO Ψ op" 
    using strips_equivalent_to_sas_plus_i_a_I[OF assms].
  then have nb: "op'  set ((φ Ψ)𝒪)"
    using assms(2) op_in op'_is 
    by fastforce
  thus "op'  set ((φ Ψ)𝒪)"
    and "is_valid_operator_strips  op'" 
    proof -
      have "op'  set ?ops'. is_valid_operator_strips  op'"
        using is_valid_problem_sas_plus_then_strips_transformation_too_iii[OF assms(1)]
        unfolding list_all_iff. 
      thus "is_valid_operator_strips  op'" 
        using nb
        by fastforce
    qed fastforce
qed

(* TODO make private *)
lemma strips_equivalent_to_sas_plus_i_a_III:
  assumes "is_valid_problem_sas_plus Ψ" 
    and "op  set ops. op  set ((Ψ)𝒪+)"
  shows "execute_parallel_operator (φS Ψ s) [φO Ψ op. op  ops]
    = (φS Ψ (execute_parallel_operator_sas_plus s ops))"
proof -
  {
    fix op s
    assume "op  set ((Ψ)𝒪+)" 
    moreover have "(φO Ψ op)  set ((φ Ψ)𝒪)"
      using calculation 
      by simp
    moreover have "(φS Ψ s) ++ map_of (effect_to_assignments (φO Ψ op))
      = (φS Ψ (s ++ map_of (effect_of (φO¯ Ψ (φO Ψ op)))))"
      using sas_plus_equivalent_to_strips_i_a_XI[OF assms(1) calculation(2)]
      by blast
    moreover have "(φO¯ Ψ (φO Ψ op)) = op"
      using sas_plus_operator_inverse_is[OF assms(1) calculation(1)].
    ultimately have "(φS Ψ s)  (φO Ψ op)
      = (φS Ψ (s + op))" 
      unfolding execute_operator_def execute_operator_sas_plus_def 
      by simp
  } note nb1 = this
  show ?thesis 
    using assms
    proof (induction ops arbitrary: s)
      case Nil
      then show ?case 
        unfolding execute_parallel_operator_def execute_parallel_operator_sas_plus_def 
        by simp
    next
      case (Cons op ops)
      let ?t = "s + op"
      let ?s' = "φS Ψ s" 
        and ?ops' = "[φO Ψ op. op  op # ops]"
      let ?t' = "?s'  (φO Ψ op)"
      have "execute_parallel_operator ?s' ?ops' 
        = execute_parallel_operator ?t' [φO Ψ x. x  ops]"
        unfolding execute_operator_def
        by simp
      moreover have "(φS Ψ (execute_parallel_operator_sas_plus s (op # ops)))
        = (φS Ψ (execute_parallel_operator_sas_plus ?t ops))" 
        unfolding execute_operator_sas_plus_def
        by simp
      moreover {
        have "?t' = (φS Ψ ?t)"
          using nb1 Cons.prems(2)
          by simp
        hence "execute_parallel_operator ?t'[φO Ψ x. x  ops] 
          = (φS Ψ (execute_parallel_operator_sas_plus ?t ops))" 
          using Cons.IH[of ?t] Cons.prems
          by simp
      }
      ultimately show ?case 
        by argo
    qed
qed

private lemma strips_equivalent_to_sas_plus_i_a_IV:
  assumes "is_valid_problem_sas_plus Ψ"
    and "op  set ops. op  set ((Ψ)𝒪+)"
    and "are_all_operators_applicable_in I ops 
     are_all_operator_effects_consistent ops"
  shows "STRIPS_Semantics.are_all_operators_applicable (φS Ψ I) [φO Ψ op. op  ops]
     STRIPS_Semantics.are_all_operator_effects_consistent [φO Ψ op. op  ops]"
proof -
  let ?vs = "variables_of Ψ" 
    and ?ops = "operators_of Ψ" 
  let ?I' = "φS Ψ I" 
    and ?ops' = "[φO Ψ op. op  ops]"
  have nb1: "op  set ops. is_operator_applicable_in I op"
    using assms(3) 
    unfolding are_all_operators_applicable_in_def list_all_iff
    by blast
  have nb2: "op  set ops. is_valid_operator_sas_plus Ψ op"
    using is_valid_problem_sas_plus_then(2) assms(1, 2)
    unfolding is_valid_operator_sas_plus_def
    by auto
  have nb3: "op  set ops. map_of (precondition_of op) m I" 
    using nb1 
    unfolding is_operator_applicable_in_def list_all_iff 
    by blast
  {
    fix op1 op2
    assume "op1  set ops" and "op2  set ops" 
    hence "are_operator_effects_consistent op1 op2" 
      using assms(3)
      unfolding are_all_operator_effects_consistent_def list_all_iff 
      by blast
  } note nb4 = this
  {
    fix op1 op2
    assume "op1  set ops" and "op2  set ops"
    hence "(v, a)  set (effect_of op1). (v', a')  set (effect_of op2).
      v  v'  a = a'"
      using nb4
      unfolding are_operator_effects_consistent_def Let_def list_all_iff
      by presburger
  } note nb5 = this
  {
    fix op1' op2' I
    assume "op1'  set ?ops'" 
      and "op2'  set ?ops'" 
      and "(v, a)  set (add_effects_of op1'). (v', a')  set (delete_effects_of op2').
        (v, a) = (v', a')" 
    moreover obtain op1 op2
      where "op1  set ops" 
          and "op1' = φO Ψ op1" 
        and "op2  set ops" 
          and "op2' = φO Ψ op2" 
      using strips_equivalent_to_sas_plus_i_a_I[OF assms(1, 2)] calculation(1, 2) 
      by auto
    moreover have "is_valid_operator_sas_plus Ψ op1"
       and is_valid_operator_op2: "is_valid_operator_sas_plus Ψ op2"
      using calculation(4, 6) nb2 
       by blast+
    moreover obtain v v' a a' 
      where "(v, a)  set (add_effects_of op1')" 
        and "(v', a')  set (delete_effects_of op2')"
        and "(v, a) = (v', a')" 
      using calculation
      by blast
    moreover have "(v, a)  set (effect_of op1)" 
      using calculation(5, 10) 
      unfolding SAS_Plus_STRIPS.sasp_op_to_strips_def
        sasp_op_to_strips_def Let_def
      by fastforce
    moreover have "v = v'" and "a = a'"
      using calculation(12) 
      by simp+
    moreover {
      have "(v', a')  ((v, a)  set (effect_of op2). 
        { (v, a') | a'. a'  (+ Ψ v)   a'  a })"
        using sasp_op_to_strips_set_delete_effects_is 
          calculation(7, 9, 11)
        by blast
      then obtain v'' a'' where "(v'', a'')  set (effect_of op2)" 
        and "(v', a')  { (v'', a''') | a'''. a'''  (+ Ψ v'')   a'''  a'' }"
        by blast
      moreover have "(v', a'')  set (effect_of op2)" 
        using calculation 
        by blast
      moreover have "a'  + Ψ v''" and "a'  a''"
        using calculation(1, 2) 
        by fast+
      ultimately have "a''. (v', a'')  set (effect_of op2)  a'  (+ Ψ v') 
         a'  a''" 
        by blast
    }
    moreover obtain a'' where "a'  + Ψ v'" 
      and "(v', a'')  set (effect_of op2)" 
      and "a'  a''"
      using calculation(16)
      by blast
    moreover have "(v, a)  set (effect_of op1). ((v', a')  set (effect_of op2). 
      v = v'  a  a')"
      using calculation(13, 14, 15, 17, 18, 19)
      by blast
    ― ‹ TODO slow. ›
    ultimately have "op1  set ops. op2  set ops. ¬are_operator_effects_consistent op1 op2"
      unfolding are_operator_effects_consistent_def list_all_iff
      by fastforce
  } note nb6 = this
  show ?thesis
    proof (rule conjI)
      {
        fix op' 
        assume "op'  set ?ops'" 
        moreover obtain op where op_in: "op  set ops" 
          and op'_is: "op' = φO Ψ op"
          and op'_in: "op'  set ((φ Ψ)𝒪)"
          and is_valid_op': "is_valid_operator_strips (φ Ψ) op'"
          using strips_equivalent_to_sas_plus_i_a_I[OF assms(1, 2)]
            strips_equivalent_to_sas_plus_i_a_II[OF assms(1, 2)] calculation 
          by metis
        moreover have is_valid_op: "is_valid_operator_sas_plus Ψ op"
          using nb2 calculation(2)..
        {
          fix v a
          assume v_a_in_preconditions': "(v, a)  set (strips_operator.precondition_of op')"
          have v_a_in_preconditions: "(v, a)  set (precondition_of op)" 
            using op'_is
            unfolding SAS_Plus_STRIPS.sasp_op_to_strips_def
              sasp_op_to_strips_def Let_def
            using v_a_in_preconditions' 
            by force
          moreover have "v  set ?vs" and "a  + Ψ v"
            using is_valid_operator_sas_plus_then(1,2) is_valid_op calculation(1)
            by fastforce+
          moreover {
            have "(v, a)  set (precondition_of op). (v', a')  set (precondition_of op).
              v  v'  a = a'" 
              using is_valid_operator_sas_plus_then(5) is_valid_op
              by fast
            hence "map_of (precondition_of op) v = Some a" 
              using map_of_constant_assignments_defined_if[OF _ v_a_in_preconditions]
              by blast
          }
          moreover have "v  dom (map_of (precondition_of op))" 
            using calculation(4)
            by blast
          moreover have "I v = Some a" 
            using nb3 
            unfolding map_le_def 
            using op_in calculation(4, 5)
            by metis
          moreover have "(v, a)  dom ?I'" 
            using state_to_strips_state_dom_element_iff[OF assms(1)] 
              calculation(2, 3, 6)
            by simp
          ultimately have "?I' (v, a) = Some True" 
            using state_to_strips_state_range_is[OF assms(1)]
            by simp
        }
        hence "STRIPS_Representation.is_operator_applicable_in ?I' op'" 
          unfolding 
            STRIPS_Representation.is_operator_applicable_in_def 
            Let_def list_all_iff 
          by fast
      }
      thus "are_all_operators_applicable ?I' ?ops'"
        unfolding are_all_operators_applicable_def list_all_iff
        by blast
    next 
      {
        fix op1' op2'
        assume op1'_in_ops': "op1'  set ?ops'" and op2'_in_ops': "op2'  set ?ops'" 
        have "STRIPS_Semantics.are_operator_effects_consistent op1' op2'" 
          unfolding STRIPS_Semantics.are_operator_effects_consistent_def Let_def
          ― ‹ TODO proof is symmetrical... refactor into nb. ›
          proof (rule conjI)          
            show "¬list_ex (λx. list_ex ((=) x) (delete_effects_of op2')) 
              (add_effects_of op1')"
              proof (rule ccontr)
                assume "¬¬list_ex (λv. list_ex ((=) v) (delete_effects_of op2')) 
                  (add_effects_of op1')" 
                then have "(v, a)  set (delete_effects_of op2'). 
                  (v', a')  set (add_effects_of op1'). (v, a) = (v', a')" 
                  unfolding list_ex_iff 
                  by fastforce
                then obtain op1 op2 where "op1  set ops"
                  and "op2  set ops" 
                  and "¬are_operator_effects_consistent op1 op2" 
                  using nb6[OF op1'_in_ops' op2'_in_ops']
                  by blast
                thus False 
                  using nb4
                  by blast              
              qed
          next
            show "¬list_ex (λv. list_ex ((=) v) (add_effects_of op2')) (delete_effects_of op1')" 
              proof (rule ccontr)
                assume "¬¬list_ex (λv. list_ex ((=) v) (add_effects_of op2')) 
                  (delete_effects_of op1')" 
                then have "(v, a)  set (delete_effects_of op1'). 
                  (v', a')  set (add_effects_of op2'). (v, a) = (v', a')" 
                  unfolding list_ex_iff
                  by fastforce
                then obtain op1 op2 where "op1  set ops"
                  and "op2  set ops" 
                  and "¬are_operator_effects_consistent op1 op2" 
                  using nb6[OF op2'_in_ops' op1'_in_ops']
                  by blast
                thus False 
                  using nb4
                  by blast
              qed
          qed
      }
      thus "STRIPS_Semantics.are_all_operator_effects_consistent ?ops'" 
        unfolding STRIPS_Semantics.are_all_operator_effects_consistent_def list_all_iff
        by blast
    qed
qed

private lemma strips_equivalent_to_sas_plus_i_a_V:
  assumes "is_valid_problem_sas_plus Ψ"
    and "op  set ops. op  set ((Ψ)𝒪+)"
    and "¬(are_all_operators_applicable_in s ops 
     are_all_operator_effects_consistent ops)"
  shows "¬(STRIPS_Semantics.are_all_operators_applicable (φS Ψ s) [φO Ψ op. op  ops]
     STRIPS_Semantics.are_all_operator_effects_consistent [φO Ψ op. op  ops])"
proof -
  let ?vs = "variables_of Ψ"
    and ?ops = "operators_of Ψ" 
  let ?s' = "φS Ψ s"
    and ?ops' = "[φO Ψ op. op  ops]"
  {
    fix op
    assume "op  set ops" 
    hence "op'  set ?ops'. op' = φO Ψ op" 
      by simp
  } note nb1 = this
  {
    fix op
    assume "op  set ops" 
    then have "op  set ((Ψ)𝒪+)" 
      using assms(2) 
      by blast
    then have "is_valid_operator_sas_plus Ψ op"
      using is_valid_problem_sas_plus_then(2) assms(1)
      unfolding is_valid_operator_sas_plus_def
      by auto
    hence "(v, a)  set (precondition_of op). (v', a')  set (precondition_of op).
      v  v'  a = a'" 
      using is_valid_operator_sas_plus_then(5)
      unfolding is_valid_operator_sas_plus_def
      by fast
  } note nb2 = this
  {
    consider (A) "¬are_all_operators_applicable_in s ops" 
      | (B) "¬are_all_operator_effects_consistent ops" 
      using assms(3)
      by blast
    hence "¬STRIPS_Semantics.are_all_operators_applicable ?s' ?ops' 
       ¬STRIPS_Semantics.are_all_operator_effects_consistent ?ops'"
      proof (cases)
        case A
        then obtain op where op_in: "op  set ops" 
          and not_precondition_map_le_s: "¬(map_of (precondition_of op) m s)"
          using A
          unfolding are_all_operators_applicable_in_def list_all_iff 
            is_operator_applicable_in_def
          by blast
        then obtain op' where op'_in: "op'  set ?ops'" and op'_is: "op' = φO Ψ op" 
          using nb1
          by blast
        have "¬are_all_operators_applicable ?s' ?ops'" 
          proof (rule ccontr)
            assume "¬¬are_all_operators_applicable ?s' ?ops'"
            then have all_operators_applicable: "are_all_operators_applicable ?s' ?ops'"
              by simp
            moreover {
              fix v 
              assume "v  dom (map_of (precondition_of op))" 
              moreover obtain a where "map_of (precondition_of op) v = Some a" 
                using calculation
                by blast
              moreover have "(v, a)  set (precondition_of op)"
                using map_of_SomeD[OF calculation(2)].
              moreover have "(v, a)  set (strips_operator.precondition_of op')"
                using op'_is 
                unfolding sasp_op_to_strips_def
                  SAS_Plus_STRIPS.sasp_op_to_strips_def
                using calculation(3) 
                by auto 
              moreover have "?s' (v, a) = Some True"
                using all_operators_applicable calculation 
                unfolding are_all_operators_applicable_def 
                    STRIPS_Representation.is_operator_applicable_in_def 
                    is_operator_applicable_in_def Let_def list_all_iff 
                using op'_in
                by fast
              moreover have "(v, a)  dom ?s'" 
                using calculation(5)
                by blast
              moreover have "(v, a)  set (precondition_of op)" 
                using op'_is calculation(3)
                unfolding sasp_op_to_strips_def Let_def
                by fastforce
              moreover have "v  set ?vs" 
                and "a  + Ψ v" 
                and "s v  None" 
                using state_to_strips_state_dom_element_iff[OF assms(1)]
                  calculation(6)
                by simp+
              moreover have "?s' (v, a) = Some (the (s v) = a)" 
                using state_to_strips_state_range_is[OF 
                    assms(1) calculation(6)].
              moreover have "the (s v) = a" 
                using calculation(5, 11)
                by fastforce
              moreover have "s v = Some a" 
                using calculation(12) option.collapse[OF calculation(10)]
                by argo
              moreover have "map_of (precondition_of op) v = Some a"
                using map_of_constant_assignments_defined_if[OF nb2[OF op_in] calculation(7)].
              ultimately have "map_of (precondition_of op) v = s v"
                by argo
            }
            then have "map_of (precondition_of op) m s" 
              unfolding map_le_def
              by blast
            thus False 
              using not_precondition_map_le_s
              by simp
          qed
        thus ?thesis 
          by simp
      next
        case B
        {
          obtain op1 op2 v v' a a' 
            where "op1  set ops"
              and op2_in: "op2  set ops"
              and v_a_in: "(v, a)  set (effect_of op1)"
              and v'_a'_in: "(v', a')  set (effect_of op2)" 
              and v_is: "v = v'" and a_is: "a  a'"  
            using B 
            unfolding are_all_operator_effects_consistent_def 
              are_operator_effects_consistent_def list_all_iff Let_def
            by blast
          moreover obtain op1' op2' where "op1'  set ?ops'" and "op1' = φO Ψ op1"
            and "op1'  set ?ops'" and op2'_is: "op2' = φO Ψ op2"
            using nb1[OF calculation(1)] nb1[OF calculation(2)]
            by blast
          moreover have "(v, a)  set (add_effects_of op1')"
            using calculation(3, 8)
            unfolding SAS_Plus_STRIPS.sasp_op_to_strips_def
              sasp_op_to_strips_def Let_def
            by force
          moreover {
            have "is_valid_operator_sas_plus Ψ op1" 
              using assms(2) calculation(1) is_valid_problem_sas_plus_then(2) assms(1)
              unfolding is_valid_operator_sas_plus_def 
              by auto
            moreover have "is_valid_operator_sas_plus Ψ op2"
              using sublocale_sas_plus_finite_domain_representation_ii(2)[
                  OF assms(1)] assms(2) op2_in 
              by blast 
            moreover have "a  + Ψ v" 
              using is_valid_operator_sas_plus_then(4) calculation v_a_in
              unfolding is_valid_operator_sas_plus_def
              by fastforce
            ultimately have "(v, a)  set (delete_effects_of op2')" 
              using sasp_op_to_strips_set_delete_effects_is[of Ψ op2]
                v'_a'_in v_is a_is 
              using op2'_is 
              by blast
          }
          ― ‹ TODO slow. ›
          ultimately have "op1'  set ?ops'. op2'  set ?ops'. 
            (v, a)  set (delete_effects_of op2'). (v', a')  set (add_effects_of op1').
            (v, a) = (v', a')"
            by fastforce
        }
        then have "¬STRIPS_Semantics.are_all_operator_effects_consistent ?ops'" 
          unfolding STRIPS_Semantics.are_all_operator_effects_consistent_def 
            STRIPS_Semantics.are_operator_effects_consistent_def list_all_iff list_ex_iff Let_def 
          by blast
        thus ?thesis 
          by simp 
      qed
  }
  thus ?thesis 
    by blast
qed

(* TODO make private *)
lemma strips_equivalent_to_sas_plus_i_a:
  assumes "is_valid_problem_sas_plus Ψ" 
    and "dom I  set ((Ψ)𝒱+)"
    and "v  dom I. the (I v)  + Ψ v" 
    and "dom G  set ((Ψ)𝒱+)" 
    and "v  dom G. the (G v)  + Ψ v" 
    and "ops  set ψ. op  set ops. op  set ((Ψ)𝒪+)"
    and "G m execute_parallel_plan_sas_plus I ψ" 
  shows "(φS Ψ G) m execute_parallel_plan (φS Ψ I) (φP Ψ ψ)" 
proof -
  let  = "φ Ψ"
    and ?G' = "φS Ψ G"
  show ?thesis 
    using assms
    proof (induction ψ arbitrary: I)
      case Nil
      let ?I' = "φS Ψ I"
      have "G m I" 
        using Nil
        by simp
      moreover have "?G' m ?I'"
        using state_to_strips_state_map_le_iff[OF Nil.prems(1, 4, 5)] 
          calculation..
      ultimately show ?case 
        unfolding SAS_Plus_STRIPS.sas_plus_parallel_plan_to_strips_parallel_plan_def
          sas_plus_parallel_plan_to_strips_parallel_plan_def
        by simp
    next
      case (Cons ops ψ)
      let ?vs = "variables_of Ψ"
        and ?ops = "operators_of Ψ"
        and ?J = "execute_parallel_operator_sas_plus I ops" 
        and  = "φP Ψ (ops # ψ)"
      let ?I' = "φS Ψ I"
        and ?J' = "φS Ψ ?J"
        and ?ops' = "[φO Ψ op. op  ops]"
      {
        fix op v a
        assume "op  set ops" and "(v, a)  set (effect_of op)" 
        moreover have "op  set ?ops"
          using Cons.prems(6) calculation(1)
          by simp
        moreover have "is_valid_operator_sas_plus Ψ op" 
          using is_valid_problem_sas_plus_then(2) Cons.prems(1) calculation(3)
          unfolding is_valid_operator_sas_plus_def
          by auto
        ultimately have "v  set ((Ψ)𝒱+)" 
          and "a  + Ψ v"
          using is_valid_operator_sas_plus_then(3,4)
          by fastforce+
      } note nb1 = this
      show ?case
      proof (cases "are_all_operators_applicable_in I ops 
         are_all_operator_effects_consistent ops")
        case True
        {
          have "(φP Ψ (ops # ψ)) = ?ops' # (φP Ψ ψ)"
            unfolding sas_plus_parallel_plan_to_strips_parallel_plan_def
              SAS_Plus_STRIPS.sas_plus_parallel_plan_to_strips_parallel_plan_def 
              sasp_op_to_strips_def
              SAS_Plus_STRIPS.sasp_op_to_strips_def
            by simp
          moreover have "op  set ops. op  set ((Ψ)𝒪+)" 
            using Cons.prems(6)
            by simp
          moreover have "STRIPS_Semantics.are_all_operators_applicable ?I' ?ops'" 
            and "STRIPS_Semantics.are_all_operator_effects_consistent ?ops'" 
            using strips_equivalent_to_sas_plus_i_a_IV[OF Cons.prems(1) _ True] calculation
            by blast+
          ultimately have "execute_parallel_plan ?I'  
            = execute_parallel_plan (execute_parallel_operator ?I' ?ops') (φP Ψ ψ)"
            by fastforce
        }
        ― ‹ NOTE Instantiate the IH on the next state of the SAS+ execution 
          execute_parallel_operator_sas_plus I ops›. ›
        moreover
        {
          {
            have "dom I  set (sas_plus_problem.variables_of Ψ)"
              using Cons.prems(2)
              by blast
            moreover have "op  set ops. (v, a)  set (effect_of op). 
              v  set ((Ψ)𝒱+)" 
              using nb1(1) 
              by blast
            ultimately have "dom ?J  set ((Ψ)𝒱+)" 
              using sas_plus_equivalent_to_strips_i_a_IX[of I "set ?vs"]
              by simp
          } note nb2 = this
          moreover {
            have "dom I  set (sas_plus_problem.variables_of Ψ)"
              using Cons.prems(2)
              by blast
            moreover have "set (sas_plus_problem.variables_of Ψ)
               dom (range_of Ψ)"
              using is_valid_problem_sas_plus_dom_sas_plus_problem_range_of assms(1)
              by auto
           moreover {
              fix v 
              assume "v  dom I"  
              moreover have "v  set ((Ψ)𝒱+)" 
                using Cons.prems(2) calculation
                by blast
              ultimately have "the (I v)  set (the (range_of Ψ v))" 
                using Cons.prems(3)
                using set_the_range_of_is_range_of_sas_plus_if[OF assms(1)]
                by blast
            }
            moreover have "opset ops. (v, a)set (effect_of op).
              v  set (sas_plus_problem.variables_of Ψ)  a  set (the (range_of Ψ v))"
              using set_the_range_of_is_range_of_sas_plus_if[OF assms(1)] nb1(1) nb1(2)
              by force
            moreover have nb3: "v  dom ?J. the (?J v)  set (the (range_of Ψ v))" 
              using sas_plus_equivalent_to_strips_i_a_X[of I "set ?vs" "range_of Ψ" ops] 
                calculation
              by fast
            moreover {
              fix v
              assume "v  dom ?J"
              moreover have "v  set ((Ψ)𝒱+)"
                using nb2 calculation
                by blast
              moreover have "set (the (range_of Ψ v)) = + Ψ v" 
                using set_the_range_of_is_range_of_sas_plus_if[OF assms(1)] 
                  calculation(2)
                by presburger
              ultimately have "the (?J v)  + Ψ v" 
                using nb3
                by blast
            }
            ultimately have "v  dom ?J. the (?J v)  + Ψ v"
              by fast
          }
          moreover have "opsset ψ. opset ops. op  set ?ops" 
            using Cons.prems(6)
            by auto
          moreover have "G m execute_parallel_plan_sas_plus ?J ψ" 
            using Cons.prems(7) True
            by simp
          ultimately have "(φS Ψ G) m execute_parallel_plan ?J' (φP Ψ ψ)"
            using Cons.IH[of ?J, OF Cons.prems(1) _ _ Cons.prems(4, 5)]
            by fastforce
        }
        moreover have "execute_parallel_operator ?I' ?ops' = ?J'" 
          using assms(1) strips_equivalent_to_sas_plus_i_a_III[OF assms(1)] Cons.prems(6)
          by auto
        ultimately show ?thesis
          by argo
      next
        case False
        then have nb: "G m I" 
          using Cons.prems(7)
          by force
        moreover {
          have " = ?ops' # (φP Ψ ψ)"
            unfolding sas_plus_parallel_plan_to_strips_parallel_plan_def
              SAS_Plus_STRIPS.sas_plus_parallel_plan_to_strips_parallel_plan_def 
              sasp_op_to_strips_def
              SAS_Plus_STRIPS.sasp_op_to_strips_def Let_def
            by auto
          moreover have "set ?ops'  set (strips_problem.operators_of )"
            using strips_equivalent_to_sas_plus_i_a_II(1)[OF assms(1)] Cons.prems(6)
            by auto
          moreover have "¬(STRIPS_Semantics.are_all_operators_applicable ?I' ?ops' 
             STRIPS_Semantics.are_all_operator_effects_consistent ?ops')"
            using strips_equivalent_to_sas_plus_i_a_V[OF assms(1) _ False] Cons.prems(6)
            by force 
          ultimately have "execute_parallel_plan ?I'  = ?I'"
            by auto
        }
        moreover have "?G' m ?I'" 
          using state_to_strips_state_map_le_iff[OF Cons.prems(1, 4, 5)] nb
          by blast
        ultimately show ?thesis 
          by presburger
        qed 
    qed
qed

(* TODO make private *)
lemma strips_equivalent_to_sas_plus_i:
  assumes "is_valid_problem_sas_plus Ψ"
    and "is_parallel_solution_for_problem Ψ ψ"
  shows "(strips_problem.goal_of (φ Ψ)) m execute_parallel_plan 
    (strips_problem.initial_of (φ Ψ)) (φP Ψ ψ)" 
proof -
  let ?vs = "variables_of Ψ"
    and ?ops = "operators_of Ψ"
    and ?I = "initial_of Ψ"
    and ?G = "goal_of Ψ"
  let  = "φ Ψ"
  let ?I' = "strips_problem.initial_of "
    and ?G' = "strips_problem.goal_of "
  have "dom ?I  set ?vs"
    using is_valid_problem_sas_plus_then(3) assms(1)
    by auto
  moreover have "vdom ?I. the (?I v)  + Ψ v" 
    using is_valid_problem_sas_plus_then(4) assms(1) calculation
    by auto
  moreover have "dom ?G  set ((Ψ)𝒱+)" 
    using is_valid_problem_sas_plus_then(5) assms(1)
    by auto
  moreover have "v  dom ?G. the (?G v)  + Ψ v"
    using is_valid_problem_sas_plus_then(6) assms(1)
    by auto
  moreover have "ops  set ψ. op  set ops. op  set ?ops"
    using is_parallel_solution_for_problem_plan_operator_set[OF assms(2)]
    by fastforce
  moreover have "?G m execute_parallel_plan_sas_plus ?I ψ" 
    using assms(2) 
    unfolding is_parallel_solution_for_problem_def
    by simp
  (* TODO slow *)
  ultimately show ?thesis
    using strips_equivalent_to_sas_plus_i_a[OF assms(1), of ?I ?G ψ]
    unfolding sas_plus_problem_to_strips_problem_def
      SAS_Plus_STRIPS.sas_plus_problem_to_strips_problem_def 
      state_to_strips_state_def
      SAS_Plus_STRIPS.state_to_strips_state_def
    by force
qed

(* TODO make private *)
lemma strips_equivalent_to_sas_plus_ii:
  assumes "is_valid_problem_sas_plus Ψ"
    and "is_parallel_solution_for_problem Ψ ψ"
  shows "list_all (list_all (λop. ListMem op (strips_problem.operators_of (φ Ψ)))) (φP Ψ ψ)" 
proof -
  let ?ops = "operators_of Ψ"
  let  = "φ Ψ"
  let ?ops' = "strips_problem.operators_of "
    and  = "φP Ψ ψ"
  have "is_valid_problem_strips " 
    using is_valid_problem_sas_plus_then_strips_transformation_too[OF assms(1)]
    by simp 
  have nb1: "op  set ?ops. (op'  set ?ops'. op' = (φO Ψ op))" 
    unfolding sas_plus_problem_to_strips_problem_def
      SAS_Plus_STRIPS.sas_plus_problem_to_strips_problem_def Let_def 
      sasp_op_to_strips_def
    by force
  {
    fix ops op op'
    assume "ops  set ψ" and "op  set ops" 
    moreover have "op  set ((Ψ)𝒪+)"
      using is_parallel_solution_for_problem_plan_operator_set[OF assms(2)] 
        calculation
      by blast
    moreover obtain op' where "op'  set ?ops'" and "op' = (φO Ψ op)" 
      using nb1 calculation(3)
      by auto
    ultimately have "(φO Ψ op)  set ?ops'"
      by blast
  }
  thus ?thesis 
    unfolding list_all_iff ListMem_iff Let_def  
      sas_plus_problem_to_strips_problem_def
      SAS_Plus_STRIPS.sas_plus_problem_to_strips_problem_def
      sas_plus_parallel_plan_to_strips_parallel_plan_def
      SAS_Plus_STRIPS.sas_plus_parallel_plan_to_strips_parallel_plan_def 
      sasp_op_to_strips_def
      SAS_Plus_STRIPS.sasp_op_to_strips_def 
      Let_def 
    by auto
qed

text ‹ The following lemma proves the complementary proposition to theorem 
\ref{isathm:equivalence-parallel-strips-parallel-sas-plus}. Namely, given a parallel solution
termψ for a SAS+ problem, the transformation to a STRIPS plan termφP Ψ ψ also is a solution 
to the corresponding STRIPS problem termΠ  (φ Ψ). In this direction, we have to show that the 
execution of the transformed plan reaches the goal state termG'  strips_problem.goal_of Π 
of the corresponding STRIPS problem, i.e.
  @{text[display, indent=4] "G' ⊆m execute_parallel_plan I' π"} 
and that all operators in the transformed plan termπ are operators of termΠ. ›

theorem
  strips_equivalent_to_sas_plus:
  assumes "is_valid_problem_sas_plus Ψ"
    and "is_parallel_solution_for_problem Ψ ψ"
  shows "STRIPS_Semantics.is_parallel_solution_for_problem (φ Ψ) (φP Ψ ψ)"
proof -
  let  = "φ Ψ"
  let ?I' = "strips_problem.initial_of "
    and ?G' = "strips_problem.goal_of "
    and ?ops' = "strips_problem.operators_of "
    and  = "φP Ψ ψ"
  show ?thesis
    unfolding STRIPS_Semantics.is_parallel_solution_for_problem_def 
    proof (rule conjI)
      show "?G' m execute_parallel_plan ?I' "
        using strips_equivalent_to_sas_plus_i[OF assms]
        by simp
    next 
      show "list_all (list_all (λop. ListMem op ?ops')) " 
        using strips_equivalent_to_sas_plus_ii[OF assms].
    qed
qed

lemma embedded_serial_sas_plus_plan_operator_structure:
  assumes "ops  set (embed ψ)"
  obtains op 
  where "op  set ψ" 
    and "[φO Ψ op. op  ops] = [φO Ψ op]"
proof -
  let ?ψ' = "embed ψ"
  {
    have "?ψ' = [[op]. op  ψ]"
      by (induction ψ; force)
    moreover obtain op where "ops = [op]" and "op  set ψ" 
      using assms calculation 
      by fastforce
    ultimately have "op  set ψ. [φO Ψ op. op  ops] = [φO Ψ op]"
      by auto
  }
  thus ?thesis 
    using that
    by meson
qed

private lemma serial_sas_plus_equivalent_to_serial_strips_i: 
  assumes "ops  set (φP Ψ (embed ψ))"
  obtains op where "op  set ψ" and "ops = [φO Ψ op]"  
proof -
  let ?ψ' = "embed ψ" 
  {
    have "set (φP Ψ (embed ψ)) = { [φO Ψ op. op  ops]  | ops. ops  set ?ψ' }"
      
      unfolding sas_plus_parallel_plan_to_strips_parallel_plan_def  
        SAS_Plus_STRIPS.sas_plus_parallel_plan_to_strips_parallel_plan_def
        sasp_op_to_strips_def set_map
      using setcompr_eq_image  
      by blast
    moreover obtain ops' where "ops'  set ?ψ'" and "ops = [φO Ψ op. op  ops']" 
      using assms(1) calculation
      by blast
    moreover obtain op where "op  set ψ" and "ops = [φO Ψ op]" 
      using embedded_serial_sas_plus_plan_operator_structure calculation(2, 3)
      by blast
    ultimately have "op  set ψ. ops = [φO Ψ op]"
      by meson
  }
  thus ?thesis 
    using that..
qed

private lemma serial_sas_plus_equivalent_to_serial_strips_ii[simp]:
  "concat (φP Ψ (embed ψ)) = [φO Ψ op. op  ψ]" 
proof -
  let ?ψ' = "List_Supplement.embed ψ"
  have "concat (φP Ψ ?ψ') = map (λop. φO Ψ op) (concat ?ψ')" 
    unfolding sas_plus_parallel_plan_to_strips_parallel_plan_def
      SAS_Plus_STRIPS.sas_plus_parallel_plan_to_strips_parallel_plan_def
      sasp_op_to_strips_def
      SAS_Plus_STRIPS.sasp_op_to_strips_def Let_def
      map_concat
    by blast
  also have " = map (λop. φO Ψ op) ψ" 
    unfolding concat_is_inverse_of_embed[of ψ]..
  finally show "concat (φP Ψ (embed ψ)) = [φO Ψ op. op  ψ]".
qed

text ‹ Having established the equivalence of parallel STRIPS and SAS+, we can now show the 
equivalence in the serial case. The proof combines the 
embedding theorem for serial SAS+ solutions (\ref{isathm:serial-sas-plus-embedding}), the parallel 
plan equivalence theorem \ref{isathm:equivalence-parallel-sas-plus-parallel-strips}, and the 
flattening theorem for parallel STRIPS plans (\ref{isathm:embedded-serial-plan-flattening-strips}).
More precisely, given a serial SAS+ solution termψ for a SAS+ problem termΨ, the embedding 
theorem confirms that the embedded plan term‹embed ψ is an equivalent parallel solution to
termΨ. By parallel plan equivalence, termπ  φP Ψ (embed ψ) is a parallel solution for the 
corresponding STRIPS problem termφ Ψ. Moreover, since term‹embed ψ is a plan consisting of 
singleton parallel operators, the same is true for termπ. Hence, the flattening lemma applies 
and term‹concat π is a serial solution for termφ Ψ. Since term‹concat› moreover can be shown 
to be the inverse of term‹embed›, the term 
  @{text[display, indent=4] "concat π = concat (φP Ψ (embed ψ))"}
can be reduced to the intuitive form 
  @{text[display, indent=4] "π = [φO Ψ op. op ← ψ]"}
which concludes the proof. ›

theorem 
  serial_sas_plus_equivalent_to_serial_strips:
  assumes "is_valid_problem_sas_plus Ψ" 
    and "SAS_Plus_Semantics.is_serial_solution_for_problem Ψ ψ"
  shows "STRIPS_Semantics.is_serial_solution_for_problem (φ Ψ) [φO Ψ op. op  ψ]" 
proof -
  let ?ψ' = "embed ψ"
    and  = "φ Ψ"
  let ?π' = "φP Ψ ?ψ'"
  let  = "concat ?π'"
  {
    have "SAS_Plus_Semantics.is_parallel_solution_for_problem Ψ ?ψ'"
      using execute_serial_plan_sas_plus_is_execute_parallel_plan_sas_plus[OF assms]
      by simp
    hence "STRIPS_Semantics.is_parallel_solution_for_problem  ?π'"
      using strips_equivalent_to_sas_plus[OF assms(1)]
      by simp
  }
  moreover have " = [φO Ψ op. op  ψ]"
    by simp
  moreover have "is_valid_problem_strips "
      using is_valid_problem_sas_plus_then_strips_transformation_too[OF assms(1)].
  moreover have "ops  set ?π'. op  set ψ. ops = [φO Ψ op]" 
    using serial_sas_plus_equivalent_to_serial_strips_i[of _ Ψ ψ]
    by metis
  ultimately show ?thesis
    using STRIPS_Semantics.flattening_lemma[of ]
    by metis
qed


lemma embedded_serial_strips_plan_operator_structure:
  assumes "ops'  set (embed π)"
  obtains op 
    where "op  set π" and "[φO¯ Π op. op  ops'] = [φO¯ Π op]"
proof -
  let ?π' = "embed π" 
  {
    have "?π' = [[op]. op  π]"
      by (induction π; force)
    moreover obtain op where "ops' = [op]" and "op  set π" 
      using calculation assms 
      by fastforce
    ultimately have "op  set π. [φO¯ Π op. op  ops'] = [φO¯ Π op]"
      by auto
  }
  thus ?thesis 
    using that
    by meson
qed

private lemma serial_strips_equivalent_to_serial_sas_plus_i: 
  assumes "ops  set (φP¯ Π (embed π))"
  obtains op where "op  set π" and "ops = [φO¯ Π op]"  
proof -
  let ?π' = "embed π" 
  {
    have "set (φP¯ Π (embed π)) = { [φO¯ Π op. op  ops]  | ops. ops  set ?π' }"
      unfolding strips_parallel_plan_to_sas_plus_parallel_plan_def
        SAS_Plus_STRIPS.strips_parallel_plan_to_sas_plus_parallel_plan_def
        strips_op_to_sasp_def set_map
      using setcompr_eq_image 
      by blast
    moreover obtain ops' where "ops'  set ?π'" and "ops = [φO¯ Π op. op  ops']" 
      using assms(1) calculation
      by blast
    moreover obtain op where "op  set π" and "ops = [φO¯ Π op]" 
      using embedded_serial_strips_plan_operator_structure calculation(2, 3)
      by blast
    ultimately have "op  set π. ops = [φO¯ Π op]" 
      by meson
  }
  thus ?thesis 
    using that..
qed

private lemma serial_strips_equivalent_to_serial_sas_plus_ii[simp]:
  "concat (φP¯ Π (embed π)) = [φO¯ Π op. op  π]" 
proof -
  let ?π' = "List_Supplement.embed π"
  have "concat (φP¯ Π ?π') = map (λop. φO¯ Π op) (concat ?π')" 
    unfolding strips_parallel_plan_to_sas_plus_parallel_plan_def
      SAS_Plus_STRIPS.strips_parallel_plan_to_sas_plus_parallel_plan_def
      strips_op_to_sasp_def
      SAS_Plus_STRIPS.strips_op_to_sasp_def Let_def
      map_concat 
    by simp
  also have " = map (λop. φO¯ Π op) π" 
    unfolding concat_is_inverse_of_embed[of π]..
  finally show "concat (φP¯ Π (embed π)) = [φO¯ Π op. op  π]".
qed

text ‹ Using the analogous lemmas for the opposite direction, we can show the counterpart to 
theorem \ref{isathm:equivalence-serial-sas-plus-serial-strips} which shows that serial solutions 
to STRIPS solutions can be transformed to serial SAS+ solutions via composition of embedding, 
transformation and flattening. ›

theorem 
  serial_strips_equivalent_to_serial_sas_plus:
  assumes "is_valid_problem_sas_plus Ψ" 
    and "STRIPS_Semantics.is_serial_solution_for_problem (φ Ψ) π"
  shows "SAS_Plus_Semantics.is_serial_solution_for_problem Ψ [φO¯ Ψ op. op  π]" 
proof -
  let ?π' = "embed π"
    and  = "φ Ψ"
  let ?ψ' = "φP¯ Ψ ?π'"
  let  = "concat ?ψ'"
  {
    have "STRIPS_Semantics.is_parallel_solution_for_problem  ?π'"
      using embedding_lemma[OF 
          is_valid_problem_sas_plus_then_strips_transformation_too[OF assms(1)] assms(2)].
    hence "SAS_Plus_Semantics.is_parallel_solution_for_problem Ψ ?ψ'"
      using sas_plus_equivalent_to_strips[OF assms(1)]
      by simp
  }
  moreover have " = [φO¯ Ψ op. op  π]"
    by simp
  moreover have "is_valid_problem_strips "
      using is_valid_problem_sas_plus_then_strips_transformation_too[OF assms(1)].
  moreover have "ops  set ?ψ'. op  set π. ops = [φO¯ Ψ op]" 
    using serial_strips_equivalent_to_serial_sas_plus_i
    by metis
  ultimately show ?thesis
    using flattening_lemma[OF assms(1)]
    by metis
qed

subsection "Equivalence of SAS+ and STRIPS" 

― ‹ Define the sets of plans with upper length bound as well as the sets of solutions with 
upper length bound for  SAS problems and induced STRIPS problems.

 We keep this polymorphic by not specifying concrete types so it applies to both STRIPS and 
SAS+ plans. ›
abbreviation bounded_plan_set 
  where "bounded_plan_set ops k  { π. set π  set ops  length π = k }"

definition bounded_solution_set_sas_plus' 
  :: "('variable, 'domain) sas_plus_problem 
     nat
     ('variable, 'domain) sas_plus_plan set" 
  where "bounded_solution_set_sas_plus' Ψ k 
     { ψ. is_serial_solution_for_problem Ψ ψ  length ψ = k}"

abbreviation bounded_solution_set_sas_plus
  :: "('variable, 'domain) sas_plus_problem 
     nat
     ('variable, 'domain) sas_plus_plan set" 
  where "bounded_solution_set_sas_plus Ψ N 
     (k  {0..N}. bounded_solution_set_sas_plus' Ψ k)"

definition bounded_solution_set_strips'
  :: "('variable × 'domain) strips_problem 
     nat
     ('variable × 'domain) strips_plan set" 
  where "bounded_solution_set_strips' Π k
     { π. STRIPS_Semantics.is_serial_solution_for_problem Π π  length π = k }"

abbreviation bounded_solution_set_strips
  :: "('variable × 'domain) strips_problem 
     nat 
     ('variable × 'domain) strips_plan set" 
  where "bounded_solution_set_strips Π N  (k  {0..N}. bounded_solution_set_strips' Π k)"

― ‹ Show that plan transformation for all SAS Plus solutions yields a STRIPS solution for the
induced STRIPS problem with same length. 

We first show injectiveness of plan transformation λψ. [φO Ψ op. op ← ψ]› on the set of plans 
Pk ≡ bounded_plan_set (operators_of Ψ) k› with length bound k›. The injectiveness of 
Solk ≡ bounded_solution_set_sas_plus Ψ k›---the set of solutions with length bound k›--then 
follows from the subset relation Solk ⊆ Pk. ›
lemma sasp_op_to_strips_injective:
  assumes "(φO Ψ op1) = (φO Ψ op2)"
  shows "op1 = op2" 
  proof  -
    let ?op1' = "φO Ψ op1" 
      and ?op2' = "φO Ψ op2" 
    {
      have "strips_operator.precondition_of ?op1' = strips_operator.precondition_of ?op2'"
        using assms 
        by argo
      hence "sas_plus_operator.precondition_of op1 = sas_plus_operator.precondition_of op2"
        unfolding sasp_op_to_strips_def
          SAS_Plus_STRIPS.sasp_op_to_strips_def
          Let_def 
        by simp
    }
    moreover {
      have "strips_operator.add_effects_of ?op1' = strips_operator.add_effects_of ?op2'"
        using assms 
        unfolding sasp_op_to_strips_def Let_def 
        by argo
      hence "sas_plus_operator.effect_of op1 = sas_plus_operator.effect_of op2"
        unfolding sasp_op_to_strips_def Let_def
          SAS_Plus_STRIPS.sasp_op_to_strips_def
        by simp
    }
    ultimately show ?thesis 
      by simp
  qed

lemma sas_plus_formalism_and_induced_strips_formalism_are_equally_expressive_i_a:
  assumes "is_valid_problem_sas_plus Ψ"
  shows "inj_on (λψ. [φO Ψ op. op  ψ]) (bounded_plan_set (sas_plus_problem.operators_of Ψ) k)" 
  proof -
    let ?ops = "sas_plus_problem.operators_of Ψ"
      (* TODO refactor transformation definitions *)
      and P = "λψ. [φO Ψ op. op  ψ]"
    let ?P = "bounded_plan_set ?ops"
    {
      fix ψ1 ψ2
      assume ψ1_in: "ψ1  ?P k" 
        and ψ2_in: "ψ2  ?P k" 
        and φP_of_ψ1_is_φP_of_ψ2: "(P ψ1) = (P ψ2)"
      hence "ψ1 = ψ2"
        proof (induction k arbitrary: ψ1 ψ2)
          case 0
          then have "length ψ1 = 0" 
            and "length ψ2 = 0" 
            using ψ1_in ψ2_in
            unfolding bounded_solution_set_sas_plus'_def 
            by blast+
          then show ?case 
            by blast
        next
          case (Suc k)
          moreover have "length ψ1 = Suc k" and "length ψ2 = Suc k"
            using length_Suc_conv Suc(2, 3) 
            unfolding bounded_solution_set_sas_plus'_def
            by blast+
          moreover obtain op1 ψ1' where "ψ1 = op1 # ψ1'" 
            and "set (op1 # ψ1')  set ?ops"
            and "length ψ1' = k" 
            using calculation(5) Suc(2)
            unfolding length_Suc_conv
            by blast
          moreover obtain op2 ψ2' where "ψ2 = op2 # ψ2'" 
            and "set (op2 # ψ2')  set ?ops" 
            and "length ψ2' = k"
            using calculation(6) Suc(3)
            unfolding length_Suc_conv
            by blast
          moreover have "set ψ1'  set ?ops" and "set ψ2'  set ?ops" 
            using calculation(8, 11) 
            by auto+
          moreover have "ψ1'  ?P k" and "ψ2'  ?P k"
            using calculation(9, 12, 13, 14)
            by fast+
          moreover have "P ψ1' = P ψ2'" 
            using Suc.prems(3) calculation(7, 10) 
            by fastforce
          moreover have "ψ1' = ψ2'" 
            using Suc.IH[of ψ1' ψ2', OF calculation(15, 16, 17)]
            by simp
          moreover have "P ψ1 = (φO Ψ op1) # P ψ1'" 
            and "P ψ2 = (φO Ψ op2) # P ψ2'"
            using Suc.prems(3) calculation(7, 10) 
            by fastforce+
          moreover have "(φO Ψ op1) = (φO Ψ op2)" 
            using Suc.prems(3) calculation(17, 19, 20)
            by simp
          moreover have "op1 = op2" 
            using sasp_op_to_strips_injective[OF calculation(21)].
          ultimately show ?case 
            by argo
        qed
    }
    thus ?thesis 
      unfolding inj_on_def 
      by blast
  qed

private corollary sas_plus_formalism_and_induced_strips_formalism_are_equally_expressive_i_b:
  assumes "is_valid_problem_sas_plus Ψ"
  shows "inj_on (λψ. [φO Ψ op. op  ψ]) (bounded_solution_set_sas_plus' Ψ k)"
  proof -
    let ?ops = "sas_plus_problem.operators_of Ψ"
      and P = "λψ. [φO Ψ op. op  ψ]"
    {
      fix ψ
      assume "ψ  bounded_solution_set_sas_plus' Ψ k" 
      then have "set ψ  set ?ops" 
        and "length ψ = k" 
        unfolding bounded_solution_set_sas_plus'_def is_serial_solution_for_problem_def Let_def 
          list_all_iff ListMem_iff 
        by fast+
      hence "ψ  bounded_plan_set ?ops k" 
         by blast
    }
    hence "bounded_solution_set_sas_plus' Ψ k  bounded_plan_set ?ops k" 
      by blast
    moreover have "inj_on P (bounded_plan_set ?ops k)" 
      using sas_plus_formalism_and_induced_strips_formalism_are_equally_expressive_i_a[OF assms(1)].
    ultimately show ?thesis
      using inj_on_subset[of P "bounded_plan_set ?ops k" "bounded_solution_set_sas_plus' Ψ k"]
      by fast
  qed

(*
lemma "card ((λψ. [φO Ψ op. op ← ψ]) ` (bounded_solution_set_sas_plus' Ψ k)) 
  = card (bounded_solution_set_strips' (φ Ψ) k)"  sorry
*)

― ‹ Show that mapping plan transformation λψ. [φO Ψ op. op ← ψ]› over the solution set for a 
given SAS+ problem yields the solution set for the induced STRIPS problem. ›
private lemma sas_plus_formalism_and_induced_strips_formalism_are_equally_expressive_i_c:
  assumes "is_valid_problem_sas_plus Ψ"
  shows "(λψ. [φO Ψ op. op  ψ]) ` (bounded_solution_set_sas_plus' Ψ k) 
    = bounded_solution_set_strips' (φ Ψ) k" 
 proof -
   let  = "φ Ψ"
     and P = "λψ. [φO Ψ op. op  ψ]"
   let ?Solk = "bounded_solution_set_sas_plus' Ψ k"
    and ?Solk' = "bounded_solution_set_strips'  k"
   {
     assume "P ` ?Solk  ?Solk'" 
     then consider (A) "π  P ` ?Solk. π  ?Solk'"
       | (B) "π  ?Solk'. π   P ` ?Solk"
       by blast
     hence False 
       proof (cases)
         case A
         moreover obtain π where "π  P ` ?Solk" and "π  ?Solk'"
           using calculation
           by blast
         moreover obtain ψ where "length ψ = k" 
           and "SAS_Plus_Semantics.is_serial_solution_for_problem Ψ ψ" 
           and "π = P ψ" 
           using calculation(2)
           unfolding bounded_solution_set_sas_plus'_def 
           by blast
         moreover have "length π = k" and "STRIPS_Semantics.is_serial_solution_for_problem  π"
           subgoal 
             using calculation(4, 6) by auto
           subgoal
             using serial_sas_plus_equivalent_to_serial_strips
               assms(1) calculation(5) calculation(6) 
             by blast
           done
         moreover have "π  ?Solk'" 
           unfolding bounded_solution_set_strips'_def 
           using calculation(7, 8) 
           by simp
         ultimately show ?thesis
           by fast
       next
         case B
         moreover obtain π where "π  ?Solk'" and "π  P ` ?Solk"
           using calculation
           by blast
         moreover have "STRIPS_Semantics.is_serial_solution_for_problem  π"
           and "length π = k"
           using calculation(2)
           unfolding bounded_solution_set_strips'_def 
           by simp+
         ― ‹ Construct the counter example ψ ≡ [φO¯ ?Π op. op ← π]› and show that ψ ∈ ?Solk
            as well as P ψ = π› hence π ∈ ?φP ` ?Solk. ›
         moreover have "length [φO¯ Ψ op. op  π] = k"
           and "SAS_Plus_Semantics.is_serial_solution_for_problem Ψ [φO¯ Ψ op. op  π]" 
           subgoal 
             using calculation(5) 
             by simp
           subgoal 
             using serial_strips_equivalent_to_serial_sas_plus[OF assms(1)] 
               calculation(4)
             by simp
           done
         moreover have "[φO¯ Ψ op. op  π]  ?Solk" 
           unfolding bounded_solution_set_sas_plus'_def 
           using calculation(6, 7) 
           by blast
         (* TODO refactor transformation lemmas *)
         moreover {
           have "op  set π. op  set (()𝒪)"
             using calculation(4)
             unfolding STRIPS_Semantics.is_serial_solution_for_problem_def list_all_iff ListMem_iff
             by simp
           hence "P [φO¯ Ψ op. op  π] = π" 
             proof (induction π)
               case (Cons op π)
               moreover have "P [φO¯ Ψ op. op  op # π] 
                = (φO Ψ (φO¯ Ψ op)) # P [φO¯ Ψ op. op  π]"
                 by simp
               moreover have "op   set (()𝒪)" 
                 using Cons.prems
                 by simp
               moreover have "(φO Ψ (φO¯ Ψ op)) = op"
                 using strips_operator_inverse_is[OF assms(1) calculation(4)].
               moreover have "P [φO¯ Ψ op. op  π] = π" 
                 using Cons.IH Cons.prems 
                 by auto
               ultimately show ?case 
                 by argo
             qed simp
         }
         moreover have "π  P ` ?Solk" 
           using calculation(8, 9) 
           by force
         ultimately show ?thesis
           by blast
      qed
   }
   thus ?thesis 
     by blast
  qed

private lemma sas_plus_formalism_and_induced_strips_formalism_are_equally_expressive_i_d:
  assumes "is_valid_problem_sas_plus Ψ"
  shows "card (bounded_solution_set_sas_plus' Ψ k)  card (bounded_solution_set_strips' (φ Ψ) k)"
  proof -
    let  = "φ Ψ"
      and P = "λψ. [φO Ψ op. op  ψ]"
    let ?Solk = "bounded_solution_set_sas_plus' Ψ k"
      and ?Solk' = "bounded_solution_set_strips'  k"
    have "card (P ` ?Solk) = card (?Solk)"
     using sas_plus_formalism_and_induced_strips_formalism_are_equally_expressive_i_b[OF assms(1)] 
       card_image 
     by blast
    moreover have "P ` ?Solk = ?Solk'"
     using sas_plus_formalism_and_induced_strips_formalism_are_equally_expressive_i_c[OF assms(1)].
    ultimately show ?thesis 
     by simp
  qed

― ‹ The set of fixed length plans with operators in a given operator set is finite. ›
lemma bounded_plan_set_finite:
  shows "finite { π. set π  set ops  length π = k }"
  proof (induction k)
    case (Suc k)
    let ?P = "{ π. set π  set ops  length π = k }"
      and ?P' = "{ π. set π  set ops  length π = Suc k }"  
    let ?P'' = "(op  set ops. (π  ?P. { op # π }))" 
    {
      have "op π. finite { op # π }"
        by simp
      then have "op. finite (π  ?P. { op # π })" 
        using finite_UN[of ?P] Suc 
        by blast
      hence "finite ?P''" 
        using finite_UN[of "set ops"]
        by blast
    }
    moreover {
      {
        fix π
        assume "π  ?P'"
        moreover have "set π  set ops" 
          and "length π = Suc k" 
          using calculation 
          by simp+
        moreover obtain op π' where "π = op # π'" 
          using calculation (3)
          unfolding length_Suc_conv 
          by fast
        moreover have "set π'  set ops" and "op  set ops"
          using calculation(2, 4) 
          by simp+
        moreover have "length π' = k"
          using calculation(3, 4) 
          by auto
        moreover have "π'  ?P" 
          using calculation(5, 7)
          by blast
        ultimately have "π  ?P''"
          by blast
      }
      hence "?P'  ?P''"
        by blast
    }
    ultimately show ?case 
      using rev_finite_subset[of ?P'' ?P']
      by blast
  qed force

― ‹ The set of fixed length SAS+ solutions are subsets of the set of plans with fixed length and 
therefore also finite. ›
private lemma sas_plus_formalism_and_induced_strips_formalism_are_equally_expressive_ii_a:
  assumes "is_valid_problem_sas_plus Ψ"
  shows "finite (bounded_solution_set_sas_plus' Ψ k)"
proof -
  let ?Ops = "set ((Ψ)𝒪+)"
  let ?Solk = "bounded_solution_set_sas_plus' Ψ k"
    and ?Pk = "{ π. set π  ?Ops  length π = k }"
  {
    fix ψ
    assume "ψ  ?Solk"
    then have "length ψ = k" and "set ψ  ?Ops"
      unfolding bounded_solution_set_sas_plus'_def 
        SAS_Plus_Semantics.is_serial_solution_for_problem_def Let_def list_all_iff ListMem_iff
      by fastforce+
    hence "ψ  ?Pk" 
      by blast
  }
  then have "?Solk  ?Pk" 
    by force
  thus ?thesis
    using bounded_plan_set_finite rev_finite_subset[of ?Pk ?Solk]
    by auto
qed

― ‹ The set of fixed length STRIPS solutions are subsets of the set of plans with fixed length and 
therefore also finite. ›
private lemma sas_plus_formalism_and_induced_strips_formalism_are_equally_expressive_ii_b:
  assumes "is_valid_problem_sas_plus Ψ"
  shows "finite (bounded_solution_set_strips' (φ Ψ) k)"
proof -
  let  = "φ Ψ"
  let ?Ops = "set (()𝒪)"
  let ?Solk = "bounded_solution_set_strips'  k"
    and ?Pk = "{ π. set π  ?Ops  length π = k }"
  {
    fix π
    assume "π  ?Solk"
    then have "length π = k" and "set π  ?Ops"
      unfolding bounded_solution_set_strips'_def 
        STRIPS_Semantics.is_serial_solution_for_problem_def Let_def list_all_iff ListMem_iff
      by fastforce+
    hence "π  ?Pk" 
      by blast
  }
  then have "?Solk  ?Pk" 
    by force
  thus ?thesis
    using bounded_plan_set_finite rev_finite_subset[of ?Pk ?Solk] 
    unfolding state_to_strips_state_def
      SAS_Plus_STRIPS.state_to_strips_state_def operators_of_def
    by blast
qed

text ‹ With the results on the equivalence of SAS+ and STRIPS solutions, we can now show that given 
problems in both formalisms, the solution sets have the same size.
This is the property required by the definition of planning formalism equivalence presented earlier 
in theorem \ref{thm:solution-sets-sas-plus-strips-f} (\autoref{sub:equivalence-sas-plus-strips}) and 
thus end up with the desired equivalence result.

The proof uses the finiteness and disjunctiveness of the solution sets for either problem to be 
able to equivalently transform the set cardinality over the union of sets of solutions with bounded 
lengths into a sum over the cardinality of the sets of solutions with bounded length. Moreover, 
since we know that for each SAS+ solution with a given length an equivalent STRIPS solution exists 
in the solution set of the transformed problem with the same length, both sets must have the same 
cardinality. 

Hence the cardinality of the  SAS+ solution set over all lengths up to a given upper bound termN 
has the same size as the solution set of the corresponding STRIPS problem over all length up to a 
given upper bound termN. ›

theorem
  assumes "is_valid_problem_sas_plus Ψ"
  shows "card (bounded_solution_set_sas_plus Ψ N) 
    = card (bounded_solution_set_strips (φ Ψ) N)" 
  proof -
    let  = "φ Ψ"
      and ?R = "{0..N}" 
    ― ‹ Due to the disjoint nature of the bounded solution sets for fixed plan length for different 
    lengths, we can sum the individual set cardinality to obtain the cardinality of the overall SAS+ 
    resp. STRIPS solution sets. ›
    have finite_R: "finite ?R" 
      by simp
    moreover {
      have "k  ?R. finite (bounded_solution_set_sas_plus' Ψ k)" 
        using sas_plus_formalism_and_induced_strips_formalism_are_equally_expressive_ii_a[OF 
            assms(1)]..
      moreover have "j  ?R. k  ?R. j  k 
         bounded_solution_set_sas_plus' Ψ j 
           bounded_solution_set_sas_plus' Ψ k = {}"
        unfolding bounded_solution_set_sas_plus'_def 
        by blast
      (* TODO slow. *)
      ultimately have "card (bounded_solution_set_sas_plus Ψ N)
        = (k  ?R. card (bounded_solution_set_sas_plus' Ψ k))"
        using card_UN_disjoint 
        by blast
    }
    moreover {
      have "k  ?R. finite (bounded_solution_set_strips'  k)" 
        using sas_plus_formalism_and_induced_strips_formalism_are_equally_expressive_ii_b[OF 
            assms(1)]..
      moreover have "j  ?R. k  ?R. j  k 
         bounded_solution_set_strips'  j 
           bounded_solution_set_strips'  k = {}"
        unfolding bounded_solution_set_strips'_def
        by blast
      (* TODO slow. *)
      ultimately have "card (bounded_solution_set_strips  N)
        = (k  ?R. card (bounded_solution_set_strips'  k))"
        using card_UN_disjoint
        by blast
    }
    moreover {
      fix k
      have "card (bounded_solution_set_sas_plus' Ψ k)
        = card ((λψ. [φO Ψ op. op  ψ]) 
          ` bounded_solution_set_sas_plus' Ψ k)"
        using sas_plus_formalism_and_induced_strips_formalism_are_equally_expressive_i_b[OF assms]
          card_image[symmetric] 
        by blast
      hence "card (bounded_solution_set_sas_plus' Ψ k)
        = card (bounded_solution_set_strips'  k)" 
        using sas_plus_formalism_and_induced_strips_formalism_are_equally_expressive_i_c[OF assms]
        by presburger
    } 
    ultimately show ?thesis
      by presburger
  qed


end

end

Theory SAT_Plan_Base

(*
  Author: Mohammad Abdulaziz, Fred Kurz
*)
theory SAT_Plan_Base
  imports  "List-Index.List_Index"
    "Propositional_Proof_Systems.Formulas"
    "STRIPS_Semantics"
    "Map_Supplement" "List_Supplement"
    "CNF_Semantics_Supplement" "CNF_Supplement"
begin

― ‹ Hide constant and notation for \isaname{Orderings.bot_class.bot} (⊥›) to prevent warnings. ›
hide_const (open) Orderings.bot_class.bot
no_notation Orderings.bot_class.bot ("")

― ‹ Hide constant and notation for \isaname{Transitive_Closure.trancl} ((_+)›) to prevent
warnings. ›
hide_const (open) Transitive_Closure.trancl
no_notation Transitive_Closure.trancl ("(_+)" [1000] 999)

― ‹ Hide constant and notation for \isaname{Relation.converse} ((_+)›) to prevent
warnings. ›
hide_const (open) Relation.converse
no_notation Relation.converse  ("(_¯)" [1000] 999)

section "The Basic SATPlan Encoding"
text ‹ We now move on to the formalization of the basic SATPlan encoding (see
\autoref{def:basic-sat-plan-encoding-strips-problem}).

The two major results that we will obtain here are the soundness and completeness result outlined
in \autoref{thm:soundness-and-completeness-satplan-base} in
\autoref{sub:soundness-completeness-satplan}.

Let in the following Φ ≡ encode_to_sat Π t› denote the SATPlan encoding for a STRIPS problem Π›
and makespan t›. Let termk < t and I ≡ (Π)I be the initial state of Π›, G ≡ (Π)G be
its goal state, 𝒱 ≡ (Π)𝒱 its variable set, and 𝒪 ≡ (Π)𝒪 its operator set. ›
subsection "Encoding Function Definitions"
text ‹ Since the SATPlan encoding uses propositional variables for both operators and state
variables of the problem as well as time points, we define a datatype using separate constructors
---termState k n for state variables resp. termOperator k n for operator activation---to
facilitate case distinction.
The natural number values store the time index resp. the indexes of the variable or operator
within their lists in the problem representation.
% TODO Note on why formulas are used instead of CNF (simple representation and good basis; e.g.
% export to cnf lists using CNF_Formulas.cnf_lists) ›

datatype  sat_plan_variable =
  State nat nat
  | Operator nat nat

text ‹ A SATPlan formula is a regular propositional formula over SATPlan variables. We add a type
synonym to improve readability. ›

type_synonym  sat_plan_formula = "sat_plan_variable formula"

text ‹ We now continue with the concrete definitions used in the implementation of the SATPlan
encoding.  State variables are encoded as literals over SATPlan variables using the State›
constructor of \isaname{sat_plan_variable}. ›

definition  encode_state_variable
  :: "nat  nat  bool option  sat_plan_variable formula"
  where "encode_state_variable t k v  case v of
    Some True  Atom (State t k)
    | Some False  ¬ (Atom (State t k))"

text ‹ The initial state encoding (definition \ref{isadef:initial-state-encoding}) is a conjunction
of state variable encodings termA  encode_state_variable 0 n b with n ≡ index vs v› and
termb  I v = Some True› for all termv  𝒱. As we can see below, the same function but
substituting the initial state with the goal state and zero with the makespan termt produces the
goal state encoding (\ref{isadef:goal-state-encoding}).
Note that both functions construct a conjunction of clauses A  ⊥› for which it
is easy to show that we can normalize to conjunctive normal form (CNF). ›

definition  encode_initial_state
  :: "'variable strips_problem  sat_plan_variable formula" ("ΦI _" 99)
  where "encode_initial_state Π
     let I = initial_of Π
        ; vs = variables_of Π
      in (map (λv. encode_state_variable 0 (index vs v) (I v)  )
    (filter (λv. I v  None) vs))"

definition  encode_goal_state
  :: "'variable strips_problem  nat  sat_plan_variable formula" ("ΦG _" 99)
  where "encode_goal_state Π t
     let
      vs = variables_of Π
      ; G = goal_of Π
    in (map (λv. encode_state_variable t (index vs v) (G v)  )
      (filter (λv. G v  None) vs))"

text ‹ Operator preconditions are encoded using activation-implies-precondition formulation as
mentioned in \autoref{subsub:basic-sat-plan-encoding}: i.e. for each
operator termop  𝒪 and termp  set (precondition_of op) we have to encode
  @{text[display, indent=4] "Atom (Operator k (index ops op))  Atom (State k (index vs v))"}
We use the equivalent disjunction in the formalization to simplify conversion to CNF.

›

definition encode_operator_precondition
  :: "'variable strips_problem
     nat
     'variable strips_operator
     sat_plan_variable formula"
  where "encode_operator_precondition Π t op  let
      vs = variables_of Π
      ; ops = operators_of Π
    in (map (λv.
        ¬ (Atom (Operator t (index ops op)))  Atom (State t (index vs v)))
      (precondition_of op))"

definition  encode_all_operator_preconditions
  :: "'variable strips_problem
     'variable strips_operator list
     nat
     sat_plan_variable formula"
  where "encode_all_operator_preconditions Π ops t  let
      l = List.product [0..<t] ops
    in foldr () (map (λ(t, op). encode_operator_precondition Π t op) l) (¬)"

text ‹ Analogously to the operator precondition, add and delete effects of operators have to be
implied by operator activation. That being said, we have to encode both positive and negative
effects and the effect must be active at the following time point: i.e.
  @{text[display, indent=4] "Atom (Operator k m)  Atom (State (Suc k) n)"}
for add effects respectively
  @{text[display, indent=4] "Atom (Operator k m)  ¬Atom (State (Suc k) n)"}
for delete effects. We again encode the implications as their equivalent disjunctions in
definition \ref{isadef:operator-effect-encoding}. ›

definition  encode_operator_effect
  :: "'variable strips_problem
     nat
     'variable strips_operator
     sat_plan_variable formula"
  where "encode_operator_effect Π t op
     let
        vs = variables_of Π
        ; ops = operators_of Π
      in (map (λv.
              ¬(Atom (Operator t (index ops op)))
               Atom (State (Suc t) (index vs v)))
            (add_effects_of op)
          @ map (λv.
              ¬(Atom (Operator t (index ops op)))
                ¬ (Atom (State (Suc t) (index vs v))))
            (delete_effects_of op))"

definition encode_all_operator_effects
  :: "'variable strips_problem
     'variable strips_operator list
     nat
     sat_plan_variable formula"
  where "encode_all_operator_effects Π ops t
     let l = List.product [0..<t] ops
      in foldr () (map (λ(t, op). encode_operator_effect Π t op) l) (¬)"

definition encode_operators
  :: "'variable strips_problem  nat  sat_plan_variable formula"
  where "encode_operators Π t
     let ops = operators_of Π
      in encode_all_operator_preconditions Π ops t  encode_all_operator_effects Π ops t"

text ‹

Definitions \ref{isadef:negative-transition-frame-axiom-encoding} and
\ref{isadef:positive-transition-frame-axiom-encoding} similarly encode the negative resp. positive
transition frame axioms as disjunctions.  ›

definition  encode_negative_transition_frame_axiom
  :: "'variable strips_problem
     nat
     'variable
     sat_plan_variable formula"
  where "encode_negative_transition_frame_axiom Π t v
     let vs = variables_of Π
        ; ops = operators_of Π
        ; deleting_operators = filter (λop. ListMem v (delete_effects_of op)) ops
      in ¬(Atom (State t (index vs v)))
           (Atom (State (Suc t) (index vs v))
            (map (λop. Atom (Operator t (index ops op))) deleting_operators))"

definition  encode_positive_transition_frame_axiom
  :: "'variable strips_problem
     nat
     'variable
     sat_plan_variable formula"
  where "encode_positive_transition_frame_axiom Π t v
     let vs = variables_of Π
        ; ops = operators_of Π
        ; adding_operators = filter (λop. ListMem v (add_effects_of op)) ops
      in (Atom (State t (index vs v))
           (¬(Atom (State (Suc t) (index vs v)))
           (map (λop. Atom (Operator t (index ops op))) adding_operators)))"

definition encode_all_frame_axioms
  :: "'variable strips_problem  nat  sat_plan_variable formula"
  where "encode_all_frame_axioms Π t
     let l = List.product [0..<t] (variables_of Π)
      in (map (λ(k, v). encode_negative_transition_frame_axiom Π k v) l
            @ map (λ(k, v). encode_positive_transition_frame_axiom Π k v) l)"

text ‹ Finally, the basic SATPlan encoding is the
conjunction of the initial state, goal state, operator and frame axiom encoding for all time steps.
The functions \isaname{encode_operators} and \isaname{encode_all_frame_axioms}\footnote{Not shown.}
take care of mapping the operator precondition, effect and frame axiom encoding over all possible
combinations of time point and operators resp. time points, variables, and operators. ›

definition  encode_problem ("Φ _ _" 99)
  where "encode_problem Π t
     encode_initial_state Π
       (encode_operators Π t
       (encode_all_frame_axioms Π t
       (encode_goal_state Π t)))"

subsection "Decoding Function Definitions"
text ‹ Decoding plans from a valuation term𝒜 of a
SATPlan encoding entails extracting all activated operators for all
time points except the last one. We implement this by mapping over all termk < t
 and extracting activated operators---i.e. operators for which the model valuates the respective
operator encoding at time termk to true---into a parallel operator (see definition
\ref{isadef:satplan-plan-decoding}).
\footnote{This is handled by function \texttt{decode\_plan'} (not shown).} ›

― ‹ Note that due to the implementation based on lists, we have to address the problem of duplicate
operator declarations in the operator list of the problem. Since term‹index op = index op' for equal
operators, the parallel operator obtained from \isaname{decode_plan'} will contain
duplicates in case the problem's operator list does. We therefore remove duplicates first using
term‹remdups ops and then filter out activated operators. ›
definition decode_plan'
  :: "'variable strips_problem
     sat_plan_variable valuation
     nat
     'variable strips_operator list"
  where "decode_plan' Π 𝒜 i
     let ops = operators_of Π
        ; vs = map (λop. Operator i (index ops op)) (remdups ops)
      in map (λv. case v of Operator _ k  ops ! k) (filter 𝒜 vs)"


― ‹ We decode maps over range 0, …, t - 1› because the last operator takes effect in termt and
must therefore have been applied in step termt - 1. ›

definition  decode_plan
  :: "'variable strips_problem
     sat_plan_variable valuation
     nat
     'variable strips_parallel_plan" ("Φ¯ _ _ _" 99)
  where "decode_plan Π 𝒜 t  map (decode_plan' Π 𝒜) [0..<t]"

text ‹ Similarly to the operator decoding, we can decode a state at time termk from a valuation
of of the SATPlan encoding term𝒜 by constructing a map from list of assignments
term(v, 𝒜 (State k (index vs v))) for all termv  𝒱. ›

definition  decode_state_at
  :: "'variable strips_problem
     sat_plan_variable valuation
     nat
     'variable strips_state" ("ΦS¯ _ _ _" 99)
  where "decode_state_at Π 𝒜 k
     let
      vs = variables_of Π
      ; state_encoding_to_assignment = λv. (v, 𝒜 (State k (index vs v)))
    in map_of (map state_encoding_to_assignment vs)"

text ‹ We continue by setting up the \isaname{sat_plan} context for the proofs of soundness and
completeness. ›

definition encode_transitions ::"'variable strips_problem  nat  sat_plan_variable formula" ("ΦT _ _" 99) where
  "encode_transitions Π t
       SAT_Plan_Base.encode_operators Π t 
        SAT_Plan_Base.encode_all_frame_axioms Π t"

― ‹ Immediately proof the sublocale proposition for strips in order to gain access to definitions
and lemmas. ›

― ‹ Setup simp rules. ›
lemma   [simp]:
  "encode_transitions Π t
    = SAT_Plan_Base.encode_operators Π t 
      SAT_Plan_Base.encode_all_frame_axioms Π t"
  unfolding encode_problem_def encode_initial_state_def encode_transitions_def
    encode_goal_state_def decode_plan_def decode_state_at_def
  by simp+

context
begin

lemma encode_state_variable_is_lit_plus_if:
  assumes "is_valid_problem_strips Π"
    and "v  dom s"
  shows "is_lit_plus (encode_state_variable k (index (strips_problem.variables_of Π) v) (s v))"
proof -
  have "s v  None"
    using is_valid_problem_strips_initial_of_dom assms(2)
    by blast
  then consider (s_of_v_is_some_true) "s v = Some True"
    | (s_of_v_is_some_false) "s v = Some False"
    by fastforce
  thus ?thesis
    unfolding encode_state_variable_def
    by (cases, simp+)
qed

lemma is_cnf_encode_initial_state:
  assumes "is_valid_problem_strips Π"
  shows "is_cnf (ΦI Π)"
proof -
  let ?I = "(Π)I"
    and ?vs = "strips_problem.variables_of Π"
  let ?l = "map (λv. encode_state_variable 0 (index ?vs v) (?I v)  )
    (filter (λv. ?I v  None) ?vs)"
  {
    fix C
    assume c_in_set_l:"C  set ?l"
    have "set ?l = (λv. encode_state_variable 0 (index ?vs v) (?I v)  ) `
      set (filter (λv. ?I v  None) ?vs)"
      using set_map[of "λv. encode_state_variable 0 (index ?vs v) (?I v)  "
          "filter (λv. ?I v  None) ?vs"]
      by blast
    then have "set ?l = (λv. encode_state_variable 0 (index ?vs v) (?I v)  ) `
      {v  set ?vs. ?I v  None}"
      using set_filter[of "λv. ?I v  None" ?vs]
      by argo
    then obtain v
      where c_is: "C = encode_state_variable 0 (index ?vs v) (?I v)  "
      and v_in_set_vs: "v  set ?vs"
      and I_of_v_is_not_None: "?I v  None"
      using c_in_set_l
      by auto
    (* TODO refactor. *)
    {
      have "v  dom ?I"
        using I_of_v_is_not_None
        by blast
      moreover have "is_lit_plus (encode_state_variable 0 (index ?vs v) (?I v))"
        using encode_state_variable_is_lit_plus_if[OF _ calculation] assms(1)
        by blast
      moreover have "is_lit_plus "
        by simp
      ultimately have "is_disj C"
        using c_is
        by force
    }
    hence "is_cnf C"
      unfolding encode_state_variable_def
      using c_is
      by fastforce
  }
  thus ?thesis
    unfolding encode_initial_state_def SAT_Plan_Base.encode_initial_state_def Let_def initial_of_def
    using is_cnf_BigAnd[of ?l]
      by (smt is_cnf_BigAnd)
qed

lemma encode_goal_state_is_cnf:
  assumes "is_valid_problem_strips Π"
  shows "is_cnf (encode_goal_state Π t)"
proof -
  let ?I = "(Π)I"
    and ?G = "(Π)G"
    and ?vs = "strips_problem.variables_of Π"
  let ?l = "map (λv. encode_state_variable t (index ?vs v) (?G v)  )
      (filter (λv. ?G v  None) ?vs)"
  {
    fix C
    assume "C  set ?l"
    (* TODO refactor (lemma ‹encode_goal_state_is_cnf_i›) *)
    moreover {
      have "set ?l = (λv. encode_state_variable t (index ?vs v) (?G v)  )
        ` set (filter (λv. ?G v  None) ?vs)"
        unfolding set_map
        by blast
      then have "set ?l = { encode_state_variable t (index ?vs v) (?G v)  
        | v. v  set ?vs  ?G v  None }"
        by auto
    }
    moreover obtain v where C_is: "C = encode_state_variable t (index ?vs v) (?G v)   "
      and "v  set ?vs"
      and G_of_v_is_not_None: "?G v  None"
      using calculation(1)
      by auto
    (* TODO refactor. *)
    moreover {
      have "v  dom ?G"
        using G_of_v_is_not_None
        by blast
      moreover have "is_lit_plus (encode_state_variable t (index ?vs v) (?G v))"
        using assms(1) calculation
        by (simp add: encode_state_variable_is_lit_plus_if)
      moreover have "is_lit_plus "
        by simp
      ultimately have "is_disj C"
        unfolding C_is
        by force
    }
    ultimately have "is_cnf C"
      by simp
  }
  thus ?thesis
    unfolding encode_goal_state_def SAT_Plan_Base.encode_goal_state_def Let_def
    using is_cnf_BigAnd[of ?l]
    by simp
qed

private lemma encode_operator_precondition_is_cnf:
  "is_cnf (encode_operator_precondition Π k op)"
proof -
  let ?vs = "strips_problem.variables_of Π"
    and ?ops = "strips_problem.operators_of Π"
  let ?l = "map (λv. ¬ (Atom (Operator k (index ?ops op)))  Atom (State k (index ?vs v)))
    (precondition_of op)"
  {
    have "set ?l = (λv. ¬(Atom (Operator k (index ?ops op)))  Atom (State k (index ?vs v)))
      ` set (precondition_of op)"
      using set_map
      by force
    then have "set ?l = { ¬(Atom (Operator k (index ?ops op)))  Atom (State k (index ?vs v))
      | v. v  set (precondition_of op) }"
      using setcompr_eq_image[of
        "λv. ¬(Atom (Operator k (index ?ops op)))  Atom (State k (index ?vs v))"
        "λv. v  set (precondition_of op)"]
      by simp
  } note set_l_is = this
  {
    fix C
    assume "C  set ?l"
    then obtain v
      where "v  set (precondition_of op)"
      and "C = ¬(Atom (Operator k (index ?ops op)))  Atom (State k (index ?vs v))"
      using set_l_is
      by blast
    hence "is_cnf C"
      by simp
  }
  thus ?thesis
    unfolding encode_operator_precondition_def
    using is_cnf_BigAnd[of ?l]
    by meson
qed

private lemma set_map_operator_precondition[simp]:
  "set (map (λ(k, op). encode_operator_precondition Π k op) (List.product [0..<t] ops))
    = { encode_operator_precondition Π k op | k op. (k, op)  ({0..<t} × set ops) }"
proof -
  let ?l' = "List.product [0..<t] ops"
  let ?fs = "map (λ(k, op). encode_operator_precondition Π k op) ?l'"
  have set_l'_is: "set ?l' = {0..<t} × set ops"
    by simp
  moreover {
    have "set ?fs = (λ(k, op). encode_operator_precondition Π k op)
      ` ({0..<t} × set ops)"
      using set_map set_l'_is
      by simp
    also have " = { encode_operator_precondition Π k op | k op. (k, op)  {0..<t} × set ops}"
      using setcompr_eq_image
      by fast
    finally have "set ?fs  = { encode_operator_precondition Π k op
      | k op. (k, op)  ({0..<t} × set ops) }"
      by blast
  }
  thus ?thesis
    by blast
qed

private lemma is_cnf_encode_all_operator_preconditions:
  "is_cnf (encode_all_operator_preconditions Π (strips_problem.operators_of Π) t)"
proof -
  let ?l' = "List.product [0..<t] (strips_problem.operators_of Π)"
  let ?fs = "map (λ(k, op). encode_operator_precondition Π k op) ?l'"
  have "f  set ?fs. is_cnf f"
    using encode_operator_precondition_is_cnf
    by fastforce
  thus ?thesis
    unfolding encode_all_operator_preconditions_def
    using is_cnf_foldr_and_if[of ?fs]
    by presburger
qed

(* TODO refactor Appendix *)
private lemma set_map_or[simp]:
  "set (map (λv. A v  B v) vs) = { A v  B v | v. v  set vs }"
proof -
  let ?l = "map (λv. A v  B v) vs"
  have "set ?l = (λv. A v  B v) ` set vs"
    using set_map
    by force
  thus ?thesis
    using setcompr_eq_image
    by auto
qed

private lemma encode_operator_effects_is_cnf_i:
  "is_cnf ((map (λv. (¬ (Atom (Operator t (index (strips_problem.operators_of Π) op))))
     Atom (State (Suc t) (index (strips_problem.variables_of Π) v))) (add_effects_of op)))"
proof -
  let ?fs = "map (λv. ¬ (Atom (Operator t (index (strips_problem.operators_of Π) op)))
     Atom (State (Suc t) (index (strips_problem.variables_of Π) v))) (add_effects_of op)"
  {
    fix C
    assume "C  set ?fs"
    then obtain v
      where "v  set (add_effects_of op)"
        and "C = ¬(Atom (Operator t (index (strips_problem.operators_of Π) op)))
           Atom (State (Suc t) (index (strips_problem.variables_of Π) v))"
      by auto
    hence "is_cnf C"
      by fastforce
  }
  thus ?thesis
    using is_cnf_BigAnd
    by blast
qed

private lemma encode_operator_effects_is_cnf_ii:
  "is_cnf ((map (λv. ¬(Atom (Operator t (index (strips_problem.operators_of Π) op)))
     ¬(Atom (State (Suc t) (index (strips_problem.variables_of Π) v)))) (delete_effects_of op)))"
proof -
  let ?fs = "map (λv. ¬(Atom (Operator t (index (strips_problem.operators_of Π) op)))
     ¬(Atom (State (Suc t) (index (strips_problem.variables_of Π) v)))) (delete_effects_of op)"
  {
    fix C
    assume "C  set ?fs"
    then obtain v
      where "v  set (delete_effects_of op)"
        and "C = ¬(Atom (Operator t (index (strips_problem.operators_of Π) op)))
           ¬(Atom (State (Suc t) (index (strips_problem.variables_of Π) v)))"
      by auto
    hence "is_cnf C"
      by fastforce
  }
  thus ?thesis
    using is_cnf_BigAnd
    by blast
qed

private lemma encode_operator_effect_is_cnf:
  shows "is_cnf (encode_operator_effect Π t op)"
proof -
  let ?ops = "strips_problem.operators_of Π"
    and ?vs = "strips_problem.variables_of Π"
  let ?fs = "map (λv. ¬(Atom (Operator t (index ?ops op)))
       Atom (State (Suc t) (index ?vs v)))
    (add_effects_of op)"
    and ?fs' = "map (λv. ¬(Atom (Operator t (index ?ops op)))
         ¬(Atom (State (Suc t) (index ?vs v))))
      (delete_effects_of op)"
  have "encode_operator_effect Π t op = (?fs @ ?fs')"
    unfolding encode_operator_effect_def[of Π t op]
    by metis
  moreover {
    have "f  set ?fs. is_cnf f" "f  set ?fs'. is_cnf f"
      using encode_operator_effects_is_cnf_i[of t Π op]
        encode_operator_effects_is_cnf_ii[of t Π op]
      by (simp+)
    (* TODO slow. *)
    hence "f  set (?fs @ ?fs'). is_cnf f"
      by auto
  }
  ultimately show ?thesis
    using is_cnf_BigAnd[of "?fs @ ?fs'"]
    by presburger
qed

private lemma set_map_encode_operator_effect[simp]:
  "set (map (λ(t, op). encode_operator_effect Π t op) (List.product [0..<t]
      (strips_problem.operators_of Π)))
    = { encode_operator_effect Π k op
      | k op. (k, op)  ({0..<t} × set (strips_problem.operators_of Π)) }"
proof -
  let ?ops = "strips_problem.operators_of Π"
    and ?vs = "strips_problem.variables_of Π"
  let ?fs = "map (λ(t, op). encode_operator_effect Π t op) (List.product [0..<t] ?ops)"
  have "set ?fs = (λ(t, op). encode_operator_effect Π t op) ` ({0..<t} × set ?ops)"
    unfolding encode_operator_effect_def[of Π t]
    by force
  thus ?thesis
    using setcompr_eq_image[of "λ(t, op). encode_operator_effect Π t op"
        "λ(k, op). (k, op)  {0..<t} × set ?ops"]
    by force
qed

private lemma encode_all_operator_effects_is_cnf:
  assumes "is_valid_problem_strips Π"
  shows "is_cnf (encode_all_operator_effects Π (strips_problem.operators_of Π) t)"
proof -
  let ?ops = "strips_problem.operators_of Π"
  let ?l = "List.product [0..<t] ?ops"
  let ?fs = "map (λ(t, op). encode_operator_effect Π t op) ?l"
  have "f  set ?fs. is_cnf f"
    using encode_operator_effect_is_cnf
    by force
  thus ?thesis
    unfolding encode_all_operator_effects_def
    using is_cnf_foldr_and_if[of ?fs]
    by presburger
qed

lemma encode_operators_is_cnf:
  assumes "is_valid_problem_strips Π"
  shows "is_cnf (encode_operators Π t)"
  unfolding encode_operators_def
  using is_cnf_encode_all_operator_preconditions[of Π t]
    encode_all_operator_effects_is_cnf[OF assms, of t]
    is_cnf.simps(1)[of "encode_all_operator_preconditions Π (strips_problem.operators_of Π) t"
      "encode_all_operator_effects Π (strips_problem.operators_of Π) t"]
  by meson

― ‹ Simp flag alone did not do it, so we have to assign a name to this lemma as well. ›
private lemma set_map_to_operator_atom[simp]:
  "set (map (λop. Atom (Operator t (index (strips_problem.operators_of Π) op)))
      (filter (λop. ListMem v vs) (strips_problem.operators_of Π)))
    = { Atom (Operator t (index (strips_problem.operators_of Π) op))
      | op. op  set (strips_problem.operators_of Π)  v  set vs }"
proof -
  let ?ops = "strips_problem.operators_of Π"
  {
    have "set (filter (λop. ListMem v vs) ?ops)
      = { op  set ?ops. ListMem v vs }"
      using set_filter
      by force
    then have "set (filter (λop. ListMem v vs) ?ops)
      = { op. op  set ?ops  v  set vs }"
      using ListMem_iff[of v]
      by blast
  }
  then have "set (map (λop. Atom (Operator t (index ?ops op)))
      (filter (λop. ListMem v vs) ?ops))
    = (λop. Atom (Operator t (index ?ops op))) ` { op  set ?ops. v  set vs }"
    using set_map[of "λop. Atom (Operator t (index ?ops op))"]
    by presburger
  thus ?thesis
    by blast
qed

(* TODO refactor ‹Formula_Supplement› *)
lemma is_disj_big_or_if:
  assumes "f  set fs. is_lit_plus f"
  shows "is_disj fs"
  using assms
proof (induction fs)
  case (Cons f fs)
  have "is_lit_plus f"
    using Cons.prems
    by simp
  moreover have "is_disj fs"
    using Cons
    by fastforce
  ultimately show ?case
    by simp
qed simp

lemma is_cnf_encode_negative_transition_frame_axiom:
  shows "is_cnf (encode_negative_transition_frame_axiom Π t v)"
proof -
  let ?vs = "strips_problem.variables_of Π"
    and ?ops = "strips_problem.operators_of Π"
  let ?deleting = "filter (λop. ListMem v (delete_effects_of op)) ?ops"
  let ?fs = "map (λop. Atom (Operator t (index ?ops op))) ?deleting"
    and ?A = "(¬(Atom (State t (index ?vs v))))"
    and ?B = "Atom (State (Suc t) (index ?vs v))"
  {
    fix f
    assume "f  set ?fs"
    (* TODO slow. *)
    then obtain op
      where "op  set ?ops"
        and "v  set (delete_effects_of op)"
        and "f = Atom (Operator t (index ?ops op))"
      using set_map_to_operator_atom[of t Π v]
      by fastforce
    hence "is_lit_plus f"
      by simp
  } note nb = this
  {
    have "is_disj ?fs"
      using is_disj_big_or_if nb
      by blast
    then have "is_disj (?B  ?fs)"
      by force
    then have "is_disj (?A  (?B  ?fs))"
      by fastforce
    hence "is_cnf (?A  (?B  ?fs))"
      by fastforce
  }
  thus ?thesis
    unfolding encode_negative_transition_frame_axiom_def
    by meson
qed

lemma is_cnf_encode_positive_transition_frame_axiom:
  shows "is_cnf (encode_positive_transition_frame_axiom Π t v)"
proof -
  let ?vs = "strips_problem.variables_of Π"
    and ?ops = "strips_problem.operators_of Π"
  let ?adding = "filter (λop. ListMem v (add_effects_of op)) ?ops"
  let ?fs = "map (λop. Atom (Operator t (index ?ops op))) ?adding"
    and ?A = "Atom (State t (index ?vs v))"
    and ?B = "¬(Atom (State (Suc t) (index ?vs v)))"
  {
    fix f
    assume "f  set ?fs"
    (* TODO slow. *)
    then obtain op
      where "op  set ?ops"
        and "v  set (add_effects_of op)"
        and "f = Atom (Operator t (index ?ops op))"
      using set_map_to_operator_atom[of t Π v]
      by fastforce
    hence "is_lit_plus f"
      by simp
  } note nb = this
  {
    have "is_disj ?fs"
      using is_disj_big_or_if nb
      by blast
    then have "is_disj (?B  ?fs)"
      by force
    then have "is_disj (?A  (?B  ?fs))"
      by fastforce
    hence "is_cnf (?A  (?B  ?fs))"
      by fastforce
  }
  thus ?thesis
    unfolding encode_positive_transition_frame_axiom_def
    by meson
qed

private lemma encode_all_frame_axioms_set[simp]:
  "set (map (λ(k, v). encode_negative_transition_frame_axiom Π k v)
        (List.product [0..<t] (strips_problem.variables_of Π))
      @ (map (λ(k, v). encode_positive_transition_frame_axiom Π k v)
        (List.product [0..<t] (strips_problem.variables_of Π))))
    = { encode_negative_transition_frame_axiom Π k v
        | k v. (k, v)  ({0..<t} × set (strips_problem.variables_of Π)) }
       { encode_positive_transition_frame_axiom Π k v
        | k v. (k, v)  ({0..<t} × set (strips_problem.variables_of Π)) }"
proof -
  let ?l = "List.product [0..<t] (strips_problem.variables_of Π)"
  let ?A = "(λ(k, v). encode_negative_transition_frame_axiom Π k v) ` set ?l"
    and ?B = "(λ(k, v). encode_positive_transition_frame_axiom Π k v) ` set ?l"
    and ?fs = "map (λ(k, v). encode_negative_transition_frame_axiom Π k v) ?l
      @ (map (λ(k, v). encode_positive_transition_frame_axiom Π k v) ?l)"
    and ?vs = "strips_problem.variables_of Π"
  have set_l_is: "set ?l = {0..<t} × set ?vs"
    by simp
  have "set ?fs = ?A  ?B"
    using set_append
    by force
  moreover have "?A = { encode_negative_transition_frame_axiom Π k v
    | k v. (k, v)  ({0..<t} × set ?vs) }"
    using set_l_is setcompr_eq_image[of "λ(k, v). encode_negative_transition_frame_axiom Π k v"
        "λ(k, v). (k, v)  ({0..<t} × set ?vs)"]
    by fast
  moreover have "?B = { encode_positive_transition_frame_axiom Π k v
    | k v. (k, v)  ({0..<t} × set ?vs) }"
    using set_l_is setcompr_eq_image[of "λ(k, v). encode_positive_transition_frame_axiom Π k v"
        "λ(k, v). (k, v)  ({0..<t} × set ?vs)"]
    by fast
  ultimately show ?thesis
    by argo
qed

(* rename ‹is_cnf_encode_all_frame_axioms›. *)
lemma encode_frame_axioms_is_cnf:
  shows "is_cnf (encode_all_frame_axioms Π t)"
proof -
  let ?l = "List.product [0..<t] (strips_problem.variables_of Π)"
    and ?vs = "strips_problem.variables_of Π"
  let ?A = "{ encode_negative_transition_frame_axiom Π k v
    | k v. (k, v)  ({0..<t} × set ?vs) }"
    and ?B = "{ encode_positive_transition_frame_axiom Π k v
    | k v. (k, v)  ({0..<t} × set ?vs) }"
    and ?fs = "map (λ(k, v). encode_negative_transition_frame_axiom Π k v) ?l
      @ (map (λ(k, v). encode_positive_transition_frame_axiom Π k v) ?l)"
  {
    fix f
    assume "f  set ?fs"
    (* TODO slow. *)
    then consider (f_encodes_negative_frame_axiom) "f  ?A"
      | (f_encodes_positive_frame_axiom) "f  ?B"
      by fastforce
    hence "is_cnf f"
      using is_cnf_encode_negative_transition_frame_axiom
        is_cnf_encode_positive_transition_frame_axiom
      by (smt mem_Collect_eq)
  }
  thus ?thesis
    unfolding encode_all_frame_axioms_def
    using is_cnf_BigAnd[of ?fs]
    by meson
qed

lemma is_cnf_encode_problem:
  assumes "is_valid_problem_strips Π"
  shows "is_cnf (Φ Π t)"
proof -
  have "is_cnf (ΦI Π)"
    using is_cnf_encode_initial_state assms
    by auto
  moreover have "is_cnf (encode_goal_state Π t)"
    using encode_goal_state_is_cnf[OF assms]
    by simp
  moreover have "is_cnf (encode_operators Π t  encode_all_frame_axioms Π t)"
    using encode_operators_is_cnf[OF assms] encode_frame_axioms_is_cnf
    unfolding encode_transitions_def
    by simp
  ultimately show ?thesis
    unfolding encode_problem_def SAT_Plan_Base.encode_problem_def
      encode_transitions_def encode_initial_state_def[symmetric] encode_goal_state_def[symmetric]
    by simp
qed

lemma encode_problem_has_model_then_also_partial_encodings:
  assumes "𝒜  SAT_Plan_Base.encode_problem Π t"
  shows "𝒜  SAT_Plan_Base.encode_initial_state Π"
    and "𝒜  SAT_Plan_Base.encode_goal_state Π t"
    and "𝒜  SAT_Plan_Base.encode_operators Π t"
    and "𝒜  SAT_Plan_Base.encode_all_frame_axioms Π t"
  using assms
  unfolding SAT_Plan_Base.encode_problem_def
  by simp+

lemma cnf_of_encode_problem_structure:
  shows "cnf (SAT_Plan_Base.encode_initial_state Π)
     cnf (SAT_Plan_Base.encode_problem Π t)"
    and "cnf (SAT_Plan_Base.encode_goal_state Π t)
       cnf (SAT_Plan_Base.encode_problem Π t)"
    and "cnf (SAT_Plan_Base.encode_operators Π t)
       cnf (SAT_Plan_Base.encode_problem Π t)"
    and "cnf (SAT_Plan_Base.encode_all_frame_axioms Π t)
       cnf (SAT_Plan_Base.encode_problem Π t)"
  unfolding SAT_Plan_Base.encode_problem_def
    SAT_Plan_Base.encode_problem_def[of Π t] SAT_Plan_Base.encode_initial_state_def[of Π]
    SAT_Plan_Base.encode_goal_state_def[of Π t] SAT_Plan_Base.encode_operators_def
    SAT_Plan_Base.encode_all_frame_axioms_def[of Π t]
  subgoal by auto
  subgoal by force
  subgoal by auto
  subgoal by force
  done

― ‹ A technical lemma which shows a simpler form of the CNF of the initial state encoding. ›
(* TODO generalize for more encodings? *)
private lemma cnf_of_encode_initial_state_set_i:
  shows "cnf (ΦI Π) =  { cnf (encode_state_variable 0
    (index (strips_problem.variables_of Π) v) (((Π)I) v))
      | v. v  set (strips_problem.variables_of Π)  ((Π)I) v  None }"
proof -
  let ?vs = "strips_problem.variables_of Π"
    and ?I = "strips_problem.initial_of Π"
  let ?ls = "map (λv. encode_state_variable 0 (index ?vs v) (?I v)  )
    (filter (λv. ?I v  None) ?vs)"
  {
    have "cnf ` set ?ls = cnf ` (λv. encode_state_variable 0 (index ?vs v) (?I v)  )
      ` set (filter (λv. ?I v  None) ?vs)"
      using set_map[of "λv. encode_state_variable 0 (index ?vs v) (?I v)  "]
      by presburger
    also have " = (λv. cnf (encode_state_variable 0 (index ?vs v) (?I v)  ))
      ` set (filter (λv. ?I v  None) ?vs)"
      using image_comp
      by blast
    also have " = (λv. cnf (encode_state_variable 0 (index ?vs v) (?I v)))
      ` { v  set ?vs. ?I v  None }"
      using set_filter[of "λv. ?I v  None" ?vs]
      by auto
    finally have "cnf ` set ?ls = { cnf (encode_state_variable 0 (index ?vs v) (?I v))
      | v. v  set ?vs  ?I v  None }"
      using setcompr_eq_image[of "λv. cnf (encode_state_variable 0 (index ?vs v) (?I v))"]
      by presburger
  }
  moreover have "cnf (ΦI Π) =  (cnf ` set ?ls)"
    unfolding encode_initial_state_def SAT_Plan_Base.encode_initial_state_def
    using cnf_BigAnd[of ?ls]
    by meson
  ultimately show ?thesis
    by auto
qed

― ‹ A simplification lemma for the above one. ›
(* TODO Replace above lemma with this?. *)
corollary cnf_of_encode_initial_state_set_ii:
  assumes "is_valid_problem_strips Π"
  shows "cnf (ΦI Π) = (v  set (strips_problem.variables_of Π). {{
    literal_formula_to_literal (encode_state_variable 0 (index (strips_problem.variables_of Π) v)
      (strips_problem.initial_of Π v)) }})"
proof -
  let ?vs = "strips_problem.variables_of Π"
    and ?I = "strips_problem.initial_of Π"
  have nb1: "{ v. v  set ?vs  ?I v  None } = set ?vs"
    using is_valid_problem_strips_initial_of_dom assms(1)
    by auto
  (* TODO generalize and refactor. *)
  {
    fix v
    assume "v  set ?vs"
    then have "?I v  None"
      using is_valid_problem_strips_initial_of_dom assms(1)
      by auto
    then consider (I_v_is_Some_True) "?I v = Some True"
      | (I_v_is_Some_False) "?I v = Some False"
      by fastforce
    hence "cnf (encode_state_variable 0 (index ?vs v) (?I v))
      = {{ literal_formula_to_literal (encode_state_variable 0 (index ?vs v) (?I v)) }}"
      unfolding encode_state_variable_def
      by (cases, simp+)
  } note nb2 = this
  {
    have "{ cnf (encode_state_variable 0 (index ?vs v) (?I v)) | v. v  set ?vs  ?I v  None }
       = (λv. cnf (encode_state_variable 0 (index ?vs v) (?I v))) ` set ?vs"
    using setcompr_eq_image[of "λv. cnf (encode_state_variable 0 (index ?vs v) (?I v))"
        "λv. v  set ?vs  ?I v  None"] using nb1
    by presburger
    hence "{ cnf (encode_state_variable 0 (index ?vs v) (?I v)) | v. v  set ?vs  ?I v  None }
      = (λv. {{ literal_formula_to_literal (encode_state_variable 0 (index ?vs v) (?I v)) }})
        ` set ?vs"
      using nb2
      by force
  }
  thus ?thesis
    using cnf_of_encode_initial_state_set_i
    by (smt Collect_cong)
qed

(* TODO ‹∃!› is superfluous now? rm? + Above lemma basically covers this one. *)
lemma  cnf_of_encode_initial_state_set:
  assumes "is_valid_problem_strips Π"
    and "v  dom (strips_problem.initial_of Π)"
  shows "strips_problem.initial_of Π v = Some True  (∃!C. C  cnf (ΦI Π)
       C = { (State 0 (index (strips_problem.variables_of Π) v))+ })"
    and "strips_problem.initial_of Π v = Some False  (∃!C. C  cnf (ΦI Π)
       C = { (State 0 (index (strips_problem.variables_of Π) v))¯ })"
proof -
  let ?I = "(Π)I"
  let ?vs = "strips_problem.variables_of Π"
  let I = "ΦI Π"
  have nb1: "cnf (ΦI Π) =  { cnf (encode_state_variable 0 (index ?vs v)
      (strips_problem.initial_of Π v)) | v. v  set ?vs  ?I v  None }"
    using cnf_of_encode_initial_state_set_i
    by blast
  {
    have "v  set ?vs"
      using is_valid_problem_strips_initial_of_dom assms(1, 2)
      by blast
    hence "v  { v. v  set ?vs  ?I v  None }"
      using assms(2)
      by auto
  } note nb2 = this
  show "strips_problem.initial_of Π v = Some True  (∃!C. C  cnf (ΦI Π)
       C = { (State 0 (index (strips_problem.variables_of Π) v))+ })"
    and "strips_problem.initial_of Π v = Some False  (∃!C. C  cnf (ΦI Π)
       C = { (State 0 (index (strips_problem.variables_of Π) v))¯ })"
    proof (auto)
      assume i_v_is_some_true: "strips_problem.initial_of Π v = Some True"
      then have "{ (State 0 (index (strips_problem.variables_of Π) v))+ }
         cnf (encode_state_variable 0 (index (strips_problem.variables_of Π) v) (?I v))"
        unfolding encode_state_variable_def
        using i_v_is_some_true
        by auto
      thus "{ (State 0 (index (strips_problem.variables_of Π) v))+ }
         cnf (ΦI Π)"
        using nb1 nb2
        by auto
    next
      assume i_v_is_some_false: "strips_problem.initial_of Π v = Some False"
      then have "{ (State 0 (index (strips_problem.variables_of Π) v))¯ }
         cnf (encode_state_variable 0 (index (strips_problem.variables_of Π) v) (?I v))"
        unfolding encode_state_variable_def
        using i_v_is_some_false
        by auto
      thus "{ (State 0 (index (strips_problem.variables_of Π) v))¯ }
         cnf (ΦI Π)"
        using nb1 nb2
        by auto
    qed
qed

lemma cnf_of_operator_encoding_structure:
  "cnf (encode_operators Π t) = cnf (encode_all_operator_preconditions Π
      (strips_problem.operators_of Π) t)
     cnf (encode_all_operator_effects Π (strips_problem.operators_of Π) t)"
  unfolding encode_operators_def
  using cnf.simps(5)
  by metis

corollary cnf_of_operator_precondition_encoding_subset_encoding:
  "cnf (encode_all_operator_preconditions Π (strips_problem.operators_of Π) t)
     cnf (Φ Π t)"
  using cnf_of_operator_encoding_structure cnf_of_encode_problem_structure subset_trans
  unfolding encode_problem_def
  by blast

(* TODO refactor ‹CNF_Supplement› *)
lemma  cnf_foldr_and[simp]:
  "cnf (foldr () fs (¬)) = (f  set fs. cnf f)"
proof (induction fs)
  case (Cons f fs)
  have ih: "cnf (foldr () fs (¬)) = (f  set fs. cnf f)"
    using Cons.IH
    by blast
  {
    have "cnf (foldr () (f # fs) (¬)) = cnf (f  foldr () fs (¬))"
      by simp
    also have " = cnf f  cnf (foldr () fs (¬))"
      by force
    finally have "cnf (foldr () (f # fs) (¬)) = cnf f  (f  set fs. cnf f)"
      using ih
      by argo
  }
  thus ?case
    by auto
qed simp

(* TODO rm (unused)? *)
private lemma cnf_of_encode_operator_precondition[simp]:
  "cnf (encode_operator_precondition Π t op) = (v  set (precondition_of op).
    {{(Operator t (index (strips_problem.operators_of Π) op))¯
      , (State t (index (strips_problem.variables_of Π) v))+}})"
proof -
  let ?vs = "strips_problem.variables_of Π"
    and ?ops = "strips_problem.operators_of Π"
    and P = "encode_operator_precondition Π t op"
  let ?fs = "map (λv. ¬ (Atom (Operator t (index ?ops op)))  Atom (State t (index ?vs v)))
    (precondition_of op)"
    and ?A = "(λv. ¬ (Atom (Operator t (index ?ops op)))  Atom (State t (index ?vs v)))
      ` set (precondition_of op)"
  have "cnf (encode_operator_precondition Π t op) = cnf (?fs)"
    unfolding encode_operator_precondition_def
    by presburger
  also have " =  (cnf ` set ?fs)"
    using cnf_BigAnd
    by blast
  also have " = (cnf ` ?A)"
    using set_map[of "λv. ¬ (Atom (Operator t (index ?ops op)))  Atom (State t (index ?vs v))"
        "precondition_of op"]
    by argo
  also have " = (v  set (precondition_of op).
    cnf (¬(Atom (Operator t (index ?ops op)))  Atom (State t (index ?vs v))))"
    by blast
  (* TODO slow. *)
  finally show ?thesis
    by auto
qed

(* TODO Shorten proof. *)
lemma cnf_of_encode_all_operator_preconditions_structure[simp]:
  "cnf (encode_all_operator_preconditions Π (strips_problem.operators_of Π) t)
    = ((t, op)  ({..<t} × set (operators_of Π)).
      (v  set (precondition_of op).
        {{(Operator t (index (strips_problem.operators_of Π) op))¯
          , (State t (index (strips_problem.variables_of Π) v))+}}))"
proof -
  let ?vs = "strips_problem.variables_of Π"
    and ?ops = "strips_problem.operators_of Π"
  let ?l = "List.product [0..<t] ?ops"
    and P = "encode_all_operator_preconditions Π (strips_problem.operators_of Π) t"
  let ?A = "set (map (λ(t, op). encode_operator_precondition Π t op) ?l)"
  {
    have "set ?l = {0..<t} × set ((Π)𝒪)"
      by auto
    then have "?A = (λ(t, op). encode_operator_precondition Π t op) ` ({0..<t} × set ((Π)𝒪))"
      using set_map
      by force
  } note nb = this
  have "cnf P = cnf (foldr () (map (λ(t, op). encode_operator_precondition Π t op) ?l) (¬))"
    unfolding encode_all_operator_preconditions_def
    by presburger
  also have " = (f  ?A. cnf f)"
    by simp
  (* TODO slow. *)
  also have " = ((k, op)  ({0..<t} × set ((Π)𝒪)).
    cnf (encode_operator_precondition Π k op))"
    using nb
    by fastforce
  (* TODO very slow. *)
  finally show ?thesis
     by fastforce
 qed

corollary cnf_of_encode_all_operator_preconditions_contains_clause_if:
  fixes Π::"'variable STRIPS_Representation.strips_problem"
  assumes "is_valid_problem_strips (Π::'variable STRIPS_Representation.strips_problem)"
    and "k < t"
    and "op  set ((Π)𝒪)"
    and "v  set (precondition_of op)"
  shows "{ (Operator k (index (strips_problem.operators_of Π) op))¯
    , (State k (index (strips_problem.variables_of Π) v))+ }
   cnf (encode_all_operator_preconditions Π (strips_problem.operators_of Π) t)"
proof -
  let ?ops = "strips_problem.operators_of Π"
    and ?vs = "strips_problem.variables_of Π"
  let P = "encode_all_operator_preconditions Π ?ops t"
    and ?C = "{ (Operator k (index (strips_problem.operators_of Π) op))¯
      , (State k (index (strips_problem.variables_of Π) v))+ }"
  {
    have nb: "(k, op)  {..<t} × set ((Π)𝒪)"
      using assms(2, 3)
      by blast
    moreover {
      have "?C  (vset (precondition_of op).
        {{(Operator k (index (strips_problem.operators_of Π) op))¯,
          (State k (index (strips_problem.variables_of Π) v))+}})"
        using UN_iff[where A="set (precondition_of op)"
          and B="λv. {{(Operator t (index (strips_problem.operators_of Π) op))¯,
          (State t (index (strips_problem.variables_of Π) v))+}}"] assms(4)
        by blast
      hence "x{..<t} × set ((Π)𝒪).
        ?C  (case x of (k, op)  vset (precondition_of op).
        {{(Operator k (index (strips_problem.operators_of Π) op))¯,
          (State k (index (strips_problem.variables_of Π) v))+}})"
        using nb
        by blast
    }
    ultimately have "?C  ((t, op)  ({..<t} × set ((Π)𝒪)).
      (v  set (precondition_of op).
        {{ (Operator t (index ?ops op))¯, (State t (index ?vs v))+ }}))"
      by blast
  }
  thus ?thesis
    using cnf_of_encode_all_operator_preconditions_structure[of Π t]
    by argo
qed

corollary cnf_of_encode_all_operator_effects_subset_cnf_of_encode_problem:
  "cnf (encode_all_operator_effects Π (strips_problem.operators_of Π) t)
     cnf (Φ Π t)"
  using cnf_of_encode_problem_structure(3) cnf_of_operator_encoding_structure
  unfolding encode_problem_def
  by blast

private lemma cnf_of_encode_operator_effect_structure[simp]:
  "cnf (encode_operator_effect Π t op)
    = (v  set (add_effects_of op). {{ (Operator t (index (strips_problem.operators_of Π) op))¯
        , (State (Suc t) (index (strips_problem.variables_of Π) v))+ }})
       (v  set (delete_effects_of op).
        {{ (Operator t (index (strips_problem.operators_of Π) op))¯
          , (State (Suc t) (index (strips_problem.variables_of Π) v))¯ }})"
proof -
  let ?fs1 = "map (λv. ¬(Atom (Operator t (index (strips_problem.operators_of Π) op)))
     Atom (State (Suc t) (index (strips_problem.variables_of Π) v)))
    (add_effects_of op)"
    and ?fs2 = "map (λv. ¬(Atom (Operator t (index (strips_problem.operators_of Π) op)))
       ¬ (Atom (State (Suc t) (index (strips_problem.variables_of Π) v))))
      (delete_effects_of op)"
  {
    have "cnf ` set ?fs1 = cnf
        ` (λv. ¬(Atom (Operator t (index (strips_problem.operators_of Π) op)))
       Atom (State (Suc t) (index (strips_problem.variables_of Π) v))) ` set (add_effects_of op)"
      using set_map
      by force
    also have " = (λv. cnf (¬(Atom (Operator t (index (strips_problem.operators_of Π) op)))
       Atom (State (Suc t) (index (strips_problem.variables_of Π) v))))
        ` set (add_effects_of op)"
      using image_comp
      by blast
    (* TODO slow. *)
    finally have "cnf ` set ?fs1 = (λv. {{ (Operator t (index (strips_problem.operators_of Π) op))¯
      , (State (Suc t) (index (strips_problem.variables_of Π) v))+ }}) ` set (add_effects_of op)"
      by auto
  } note nb1 = this
  {
    have "cnf ` set ?fs2 = cnf ` (λv. ¬(Atom (Operator t (index (strips_problem.operators_of Π) op)))
       ¬(Atom (State (Suc t) (index (strips_problem.variables_of Π) v))))
        ` set (delete_effects_of op)"
      using set_map
      by force
    also have " = (λv. cnf (¬(Atom (Operator t (index (strips_problem.operators_of Π) op)))
       ¬ (Atom (State (Suc t) (index (strips_problem.variables_of Π) v)))))
        ` set (delete_effects_of op)"
      using image_comp
      by blast
    (* TODO slow. *)
    finally have "cnf ` set ?fs2 = (λv. {{ (Operator t (index (strips_problem.operators_of Π) op))¯
      , (State (Suc t) (index (strips_problem.variables_of Π) v))¯ }})
        ` set (delete_effects_of op)"
      by auto
  } note nb2 = this
  {
    have "cnf (encode_operator_effect Π t op) = (cnf ` set (?fs1 @ ?fs2))"
      unfolding encode_operator_effect_def
      using cnf_BigAnd[of "?fs1 @ ?fs2"]
      by meson
    also have " = (cnf ` set ?fs1  cnf ` set ?fs2)"
      using set_append[of "?fs1" "?fs2"] image_Un[of cnf "set ?fs1" "set ?fs2"]
      by argo
    also have " = (cnf ` set ?fs1)  (cnf ` set ?fs2)"
      using Union_Un_distrib[of "cnf ` set ?fs1" "cnf ` set ?fs2"]
      by argo
    (* TODO slow. *)
    finally have "cnf (encode_operator_effect Π t op)
        = (v  set (add_effects_of op).
          {{ (Operator t (index (strips_problem.operators_of Π) op))¯
            , (State (Suc t) (index (strips_problem.variables_of Π) v))+ }})
         (v  set (delete_effects_of op).
          {{ (Operator t (index (strips_problem.operators_of Π) op))¯
            , (State (Suc t) (index (strips_problem.variables_of Π) v))¯ }})"
      using nb1 nb2
      by argo
  }
  thus ?thesis
    by blast
qed

lemma cnf_of_encode_all_operator_effects_structure:
  "cnf (encode_all_operator_effects Π (strips_problem.operators_of Π) t)
    = ((k, op)  ({0..<t} × set ((Π)𝒪)).
        (v  set (add_effects_of op).
          {{ (Operator k (index (strips_problem.operators_of Π) op))¯
            , (State (Suc k) (index (strips_problem.variables_of Π) v))+ }}))
       ((k, op)  ({0..<t} × set ((Π)𝒪)).
        (v  set (delete_effects_of op).
          {{ (Operator k (index (strips_problem.operators_of Π) op))¯
            , (State (Suc k) (index (strips_problem.variables_of Π) v))¯ }}))"
proof -
  let ?ops = "strips_problem.operators_of Π"
    and ?vs = "strips_problem.variables_of Π"
  let E = "encode_all_operator_effects Π ?ops t"
    and ?l = "List.product [0..<t] ?ops"
  let ?fs = "map (λ(t, op). encode_operator_effect Π t op) ?l"
  have nb: "set (List.product [0..<t] ?ops) = {0..<t} × set ?ops"
    by simp
  {
    have "cnf ` set ?fs = cnf ` (λ(k, op). encode_operator_effect Π k op) ` ({0..<t} × set ?ops)"
      by force
    also have " = (λ(k, op). cnf (encode_operator_effect Π k op)) ` ({0..<t} × set ?ops)"
      using image_comp
      by fast
    (* TODO slow. *)
    finally have "cnf ` set ?fs = (λ(k, op).
          (v  set (add_effects_of op).
            {{ (Operator k (index (strips_problem.operators_of Π) op))¯
              , (State (Suc k) (index (strips_problem.variables_of Π) v))+ }})
         (v  set (delete_effects_of op).
            {{ (Operator k (index (strips_problem.operators_of Π) op))¯
              , (State (Suc k) (index (strips_problem.variables_of Π) v))¯ }}))
      ` ({0..<t} × set ?ops)"
      using cnf_of_encode_operator_effect_structure
      by auto
  }
  (* TODO slow. *)
  thus ?thesis
    unfolding encode_all_operator_effects_def
    using cnf_BigAnd[of ?fs]
    by auto
qed

corollary cnf_of_operator_effect_encoding_contains_add_effect_clause_if:
  fixes Π:: "'a strips_problem"
  assumes "is_valid_problem_strips Π"
    and "k < t"
    and "op  set ((Π)𝒪)"
    and "v  set (add_effects_of op)"
  shows "{ (Operator k (index (strips_problem.operators_of Π) op))¯
      , (State (Suc k) (index (strips_problem.variables_of Π) v))+ }
     cnf (encode_all_operator_effects Π (strips_problem.operators_of Π) t)"
proof -
  let E = "encode_all_operator_effects Π (strips_problem.operators_of Π) t"
    and ?ops = "strips_problem.operators_of Π"
    and ?vs = "strips_problem.variables_of Π"
  let ?Add = "(k, op){0..<t} × set ((Π)𝒪).
    vset (add_effects_of op). {{ (Operator k (index ?ops op))¯, (State (Suc k) (index ?vs v))+}}"
  let ?C = "{ (Operator k (index ?ops op))¯, (State (Suc k) (index ?vs v))+ }"
  have "?Add  cnf E"
    using cnf_of_encode_all_operator_effects_structure[of Π t] Un_upper1[of "?Add"]
    by presburger
  moreover {
    have "?C   {{ (Operator k (index ?ops op))¯, (State (Suc k) (index ?vs v))+ }}"
        using assms(4)
        by blast
      then have "?C  (vset (add_effects_of op).
        {{ (Operator k (index ?ops op))¯, (State (Suc k) (index ?vs v))+}})"
        using Complete_Lattices.UN_iff[of "?C" "λv. {{ (Operator k (index ?ops op))¯
          , (State (Suc k) (index ?vs v))+}}" "set (add_effects_of op)"]
      using assms(4)
      by blast
    moreover have "(k, op)  ({0..<t} × set ((Π)𝒪))"
      using assms(2, 3)
      by fastforce
    (* TODO slow step. *)
    ultimately have "?C  ?Add"
      by blast
  }
  ultimately show ?thesis
    using subset_eq[of "?Add" "cnf E"]
    by meson
qed

corollary cnf_of_operator_effect_encoding_contains_delete_effect_clause_if:
  fixes Π:: "'a strips_problem"
  assumes "is_valid_problem_strips Π"
    and "k < t"
    and "op  set ((Π)𝒪)"
    and "v  set (delete_effects_of op)"
  shows "{ (Operator k (index (strips_problem.operators_of Π) op))¯
      , (State (Suc k) (index (strips_problem.variables_of Π) v))¯ }
     cnf (encode_all_operator_effects Π (strips_problem.operators_of Π) t)"
proof -
  let E = "encode_all_operator_effects Π (strips_problem.operators_of Π) t"
    and ?ops = "strips_problem.operators_of Π"
    and ?vs = "strips_problem.variables_of Π"
  let ?Delete = "((k, op){0..<t} × set ((Π)𝒪).
    vset (delete_effects_of op).
      {{ (Operator k (index ?ops op))¯, (State (Suc k) (index ?vs v))¯ }})"
  let ?C = "{ (Operator k (index ?ops op))¯, (State (Suc k) (index ?vs v))¯ }"
  have "?Delete  cnf E"
    using cnf_of_encode_all_operator_effects_structure[of Π t] Un_upper2[of "?Delete"]
    by presburger
  moreover {
    have "?C  (v  set (delete_effects_of op).
      {{ (Operator k (index ?ops op))¯, (State (Suc k) (index ?vs v))¯ }})"
      using assms(4)
      by blast
    moreover have "(k, op)  {0..<t} × set ?ops"
    using assms(2, 3)
    by force
    (* TODO slow step. *)
    ultimately have "?C  ?Delete"
      by fastforce
  }
  (* TODO slow step. *)
  ultimately show ?thesis
    using subset_eq[of "?Delete" "cnf E"]
    by meson
qed

(* TODO refactor ‹CNF_Supplement›. *)
private lemma cnf_of_big_or_of_literal_formulas_is[simp]:
  assumes "f  set fs. is_literal_formula f"
  shows "cnf (fs) = {{ literal_formula_to_literal f | f. f  set fs }}"
  using assms
proof (induction fs)
  case (Cons f fs)
  {
    have is_literal_formula_f: "is_literal_formula f"
      using Cons.prems(1)
      by simp
    then have "cnf f = {{ literal_formula_to_literal f }}"
      using cnf_of_literal_formula
      by blast
  } note nb1 = this
  {
    have "f'  set fs. is_literal_formula f'"
      using Cons.prems
      by fastforce
    hence "cnf (fs) = {{ literal_formula_to_literal f | f. f  set fs }}"
      using Cons.IH
      by argo
  } note nb2 = this
  {
    have "cnf ((f # fs)) = (λ(g, h). g  h)
      ` ({{ literal_formula_to_literal f}}
        × {{ literal_formula_to_literal f' | f'. f'  set fs }})"
      using nb1 nb2
      by simp
    also have " = {{ literal_formula_to_literal f}
       { literal_formula_to_literal f' | f'. f'  set fs }}"
      by fast
    finally have "cnf ((f # fs)) = {{ literal_formula_to_literal f' | f'. f'  set (f # fs) }}"
      by fastforce
  }
  thus ?case .
qed simp

private lemma set_filter_op_list_mem_vs[simp]:
  "set (filter (λop. ListMem v vs) ops) = { op. op  set ops  v  set vs }"
  using set_filter[of "λop. ListMem v vs" ops] ListMem_iff
  by force

private lemma  cnf_of_positive_transition_frame_axiom:
  "cnf (encode_positive_transition_frame_axiom Π k v)
    = {{ (State k (index (strips_problem.variables_of Π) v))+
        , (State (Suc k) (index (strips_problem.variables_of Π) v))¯ }
       { (Operator k (index (strips_problem.operators_of Π) op))+
        | op. op  set (strips_problem.operators_of Π)  v  set (add_effects_of op) }}"
proof -
  let ?vs = "strips_problem.variables_of Π"
    and ?ops = "strips_problem.operators_of Π"
  let ?adding_operators = "filter (λop. ListMem v (add_effects_of op)) ?ops"
  let ?fs = "map (λop. Atom (Operator k (index ?ops op))) ?adding_operators"
  {
    have "set ?fs = (λop. Atom (Operator k (index ?ops op))) ` set ?adding_operators"
      using set_map[of "λop. Atom (Operator k (index ?ops op))" "?adding_operators"]
      by blast
    (* TODO slow. *)
    then have "literal_formula_to_literal ` set ?fs
      = (λop. (Operator k (index ?ops op))+) ` set ?adding_operators"
      using image_comp[of literal_formula_to_literal "λop. Atom (Operator k (index ?ops op))"
          "set ?adding_operators"]
      by simp
    also have " = (λop. (Operator k (index ?ops op))+)
        ` { op. op  set ?ops  v  set (add_effects_of op) }"
      using set_filter_op_list_mem_vs[of v _  ?ops]
      by auto
    (* TODO slow. *)
    finally have "literal_formula_to_literal ` set ?fs
      = { (Operator k (index ?ops op))+ | op. op  set ?ops  v  set (add_effects_of op) }"
      using setcompr_eq_image[of "λop. (Operator k (index ?ops op))+"
          "λop. op set ?adding_operators"]
      by blast
    (* TODO slow. *)
    hence "cnf (?fs) = {{ (Operator k (index ?ops op))+
      | op. op  set ?ops  v  set (add_effects_of op) }}"
      using cnf_of_big_or_of_literal_formulas_is[of ?fs]
        setcompr_eq_image[of literal_formula_to_literal "λf. f  set ?fs"]
      by force
  }
  (* TODO slow. *)
  then have "cnf (¬(Atom (State (Suc k) (index ?vs v)))  ?fs)
  = {{ (State (Suc k) (index ?vs v))¯  }  { (Operator k (index ?ops op))+
    | op. op  set ?ops  v  set (add_effects_of op) }}"
    by force
  (* TODO slow. *)
  then have "cnf ((Atom (State k (index ?vs v))  (¬(Atom (State (Suc k) (index ?vs v)))  ?fs)))
    = {{ (State k (index ?vs v))+ }
       { (State (Suc k) (index ?vs v))¯ }
       { (Operator k (index ?ops op))+ | op. op  set ?ops  v  set (add_effects_of op) }}"
    by simp
  (* TODO No idea why this is necessary (apparently only metis unfolds the definition properly). *)
  moreover have "cnf (encode_positive_transition_frame_axiom Π k v)
    = cnf ((Atom (State k (index ?vs v))  (¬(Atom (State (Suc k) (index ?vs v)))  ?fs)))"
    unfolding encode_positive_transition_frame_axiom_def
    by metis
  (* TODO slow. *)
  ultimately show ?thesis
    by blast
qed

private lemma cnf_of_negative_transition_frame_axiom:
  "cnf (encode_negative_transition_frame_axiom Π k v)
    = {{ (State k (index (strips_problem.variables_of Π) v))¯
        , (State (Suc k) (index (strips_problem.variables_of Π) v))+  }
       { (Operator k (index (strips_problem.operators_of Π) op))+
        | op. op  set (strips_problem.operators_of Π)  v  set (delete_effects_of op) }}"
proof -
  let ?vs = "strips_problem.variables_of Π"
    and ?ops = "strips_problem.operators_of Π"
  let ?deleting_operators = "filter (λop. ListMem v (delete_effects_of op)) ?ops"
  let ?fs = "map (λop. Atom (Operator k (index ?ops op))) ?deleting_operators"
  {
    have "set ?fs = (λop. Atom (Operator k (index ?ops op))) ` set ?deleting_operators"
      using set_map[of "λop. Atom (Operator k (index ?ops op))" "?deleting_operators"]
      by blast
    (* TODO slow. *)
    then have "literal_formula_to_literal ` set ?fs
      = (λop. (Operator k (index ?ops op))+) ` set ?deleting_operators"
      using image_comp[of literal_formula_to_literal "λop. Atom (Operator k (index ?ops op))"
          "set ?deleting_operators"]
      by simp
    also have " = (λop. (Operator k (index ?ops op))+)
        ` { op. op  set ?ops  v  set (delete_effects_of op) }"
      using set_filter_op_list_mem_vs[of v _  ?ops]
      by auto
    (* TODO slow. *)
    finally have "literal_formula_to_literal ` set ?fs
      = { (Operator k (index ?ops op))+ | op. op  set ?ops  v  set (delete_effects_of op) }"
      using setcompr_eq_image[of "λop. (Operator k (index ?ops op))+"
          "λop. op set ?deleting_operators"]
      by blast
    (* TODO slow. *)
    hence "cnf (?fs) = {{ (Operator k (index ?ops op))+
      | op. op  set ?ops  v  set (delete_effects_of op) }}"
      using cnf_of_big_or_of_literal_formulas_is[of ?fs]
        setcompr_eq_image[of literal_formula_to_literal "λf. f  set ?fs"]
      by force
  }
  (* TODO slow. *)
  then have "cnf (Atom (State (Suc k) (index ?vs v))  ?fs)
  = {{ (State (Suc k) (index ?vs v))+  }  { (Operator k (index ?ops op))+
    | op. op  set ?ops  v  set (delete_effects_of op) }}"
    by force
  (* TODO slow. *)
  then have "cnf ((¬(Atom (State k (index ?vs v)))  (Atom (State (Suc k) (index ?vs v))  ?fs)))
    = {{ (State k (index ?vs v))¯ }
       { (State (Suc k) (index ?vs v))+ }
       { (Operator k (index ?ops op))+ | op. op  set ?ops  v  set (delete_effects_of op) }}"
    by simp
  (* TODO unfold Let_def + remove metis. *)
  moreover have "cnf (encode_negative_transition_frame_axiom Π k v)
    = cnf ((¬(Atom (State k (index ?vs v)))  (Atom (State (Suc k) (index ?vs v))  ?fs)))"
    unfolding encode_negative_transition_frame_axiom_def
    by metis
  (* TODO slow. *)
  ultimately show ?thesis
    by blast
qed

lemma cnf_of_encode_all_frame_axioms_structure:
  "cnf (encode_all_frame_axioms Π t)
    = ((k, v)  ({0..<t} × set ((Π)𝒱)).
        {{{ (State k (index (strips_problem.variables_of  Π) v))+
            , (State (Suc k) (index (strips_problem.variables_of  Π) v))¯  }
           {(Operator k (index (strips_problem.operators_of  Π) op))+
            | op. op  set ((Π)𝒪)  v  set (add_effects_of op) }}})
       ((k, v)  ({0..<t} × set ((Π)𝒱)).
        {{{ (State k (index (strips_problem.variables_of Π) v))¯
            , (State (Suc k) (index (strips_problem.variables_of Π) v))+ }
           { (Operator k (index (strips_problem.operators_of Π) op))+
            | op. op  set ((Π)𝒪)  v  set (delete_effects_of op) }}})"
proof -
  let ?vs = "strips_problem.variables_of Π"
    and ?ops = "strips_problem.operators_of Π"
    and F = "encode_all_frame_axioms Π t"
  let ?l = "List.product [0..<t] ?vs"
  let ?fs = "map (λ(k, v). encode_negative_transition_frame_axiom Π k v) ?l
    @ map (λ(k, v). encode_positive_transition_frame_axiom Π k v) ?l"
  {
    let ?A = "{ encode_negative_transition_frame_axiom Π k v
        | k v. (k, v)  ({0..<t} × set ((Π)𝒱)) }"
      and ?B = "{ encode_positive_transition_frame_axiom Π k v
        | k v. (k, v)  ({0..<t} × set ((Π)𝒱)) }"
    have set_l: "set ?l = {..<t} × set ((Π)𝒱)"
      using set_product
      by force
    (* TODO slow *)
    have "set ?fs = ?A  ?B"
      unfolding set_append set_map
      using encode_all_frame_axioms_set
      by force
    then have "cnf ` set ?fs = cnf ` ?A  cnf ` ?B"
      using image_Un[of cnf "?A" "?B"]
      by argo
    moreover {
      have "?A = ((k, v)  ({0..<t} × set ((Π)𝒱)).
        { encode_negative_transition_frame_axiom Π k v })"
        by blast
      then have  "cnf ` ?A  = ((k, v)  ({0..<t} × set ((Π)𝒱)).
        { cnf (encode_negative_transition_frame_axiom Π k v) })"
        by blast
      hence "cnf ` ?A = ((k, v)  ({0..<t} × set ((Π)𝒱)).
        {{{ (State k (index ?vs v))¯
            , (State (Suc k) (index ?vs v))+ }
           {(Operator k (index ?ops op))+
            | op. op  set ?ops  v  set (delete_effects_of op)}}})"
        using cnf_of_negative_transition_frame_axiom[of Π]
        by presburger
    }
    moreover {
      have "?B = ((k, v)  ({0..<t} × set ((Π)𝒱)).
        { encode_positive_transition_frame_axiom Π k v})"
        by blast
      then have  "cnf ` ?B = ((k, v)  ({0..<t} × set ((Π)𝒱)).
        { cnf (encode_positive_transition_frame_axiom Π k v)  })"
        by blast
      hence "cnf ` ?B = ((k, v)  ({0..<t} × set ((Π)𝒱)).
        {{{ (State k (index ?vs v))+
            , (State (Suc k) (index ?vs v))¯ }
           {(Operator k (index ?ops op))+
            | op. op  set ?ops  v  set (add_effects_of op) }}})"
        using cnf_of_positive_transition_frame_axiom[of Π]
        by presburger
    }
    (* TODO slow *)
    ultimately have "cnf ` set ?fs
      = ((k, v)  ({0..<t} × set ((Π)𝒱)).
        {{{ (State k (index ?vs v))+
            , (State (Suc k) (index ?vs v))¯ }
           {(Operator k (index ?ops op))+
            | op. op  set ((Π)𝒪)  v  set (add_effects_of op) }}})
       ((k, v)  ({0..<t} × set ((Π)𝒱)).
        {{{ (State k (index ?vs v))¯
            , (State (Suc k) (index ?vs v))+ }
           {(Operator k (index ?ops op))+
            | op. op  set ((Π)𝒪)  v  set (delete_effects_of op)}}})"
      unfolding set_append set_map
      by force
  }
  then have "cnf (encode_all_frame_axioms Π t)
    = (((k, v)  ({0..<t} × set ((Π)𝒱)).
        {{{ (State k (index ?vs v))+
            , (State (Suc k) (index ?vs v))¯ }
           {(Operator k (index ?ops op))+
            | op. op  set ((Π)𝒪)  v  set (add_effects_of op) }}})
       ((k, v)  ({0..<t} × set ((Π)𝒱)).
        {{{ (State k (index ?vs v))¯
            , (State (Suc k) (index ?vs v))+ }
           {(Operator k (index ?ops op))+
            | op. op  set ((Π)𝒪)  v  set (delete_effects_of op)}}}))"
    unfolding encode_all_frame_axioms_def Let_def
    using cnf_BigAnd[of ?fs]
    by argo
  thus ?thesis
    using Union_Un_distrib[of
        "((k, v)  ({0..<t} × set ((Π)𝒱)).
        {{{ (State k (index ?vs v))+
            ,  (State (Suc k) (index ?vs v))¯ }
           {(Operator k (index ?ops op))+
            | op. op  set ((Π)𝒪)  v  set (add_effects_of op) }}})"
        "((k, v)  ({0..<t} × set ((Π)𝒱)).
        {{{ (State k (index ?vs v))¯
            , (State (Suc k) (index ?vs v))+ }
           {(Operator k (index ?ops op))+
            | op. op  set ((Π)𝒪)  v  set (delete_effects_of op)}}})"]
    by argo
qed

― ‹ A technical lemma used in \isaname{cnf_of_encode_goal_state_set}. ›
private lemma cnf_of_encode_goal_state_set_i:
    "cnf ((ΦG Π) t ) = ({ cnf (encode_state_variable t
      (index (strips_problem.variables_of Π) v) (((Π)G) v))
    | v. v  set ((Π)𝒱)  ((Π)G) v  None })"
proof -
  let ?vs = "strips_problem.variables_of Π"
    and ?G = "(Π)G"
    and G = "(ΦG Π) t"
  let ?fs = "map (λv. encode_state_variable t (index ?vs v) (?G v)  )
      (filter (λv. ?G v  None) ?vs)"
  {
    have "cnf ` set ?fs  = cnf ` (λv. encode_state_variable t (index ?vs v) (?G v)  )
      ` { v | v. v  set ?vs  ?G v  None }"
      unfolding set_map
      by force
    also have " = (λv. cnf (encode_state_variable t (index ?vs v) (?G v)  ))
      ` { v | v. v  set ?vs  ?G v  None }"
      using image_comp[of cnf "(λv. encode_state_variable t (index ?vs v) (?G v)  )"
          "{ v | v. v  set ?vs  ?G v  None }"]
      by fast
    finally have "cnf ` set ?fs = { cnf (encode_state_variable t (index ?vs v) (?G v))
        | v. v  set ?vs  ?G v  None }"
      unfolding setcompr_eq_image[of "λv. cnf (encode_state_variable t (index ?vs v) (?G v)  )"]
      by auto
  }
  moreover have "cnf ((ΦG Π) t) =  (cnf ` set ?fs)"
    unfolding encode_goal_state_def SAT_Plan_Base.encode_goal_state_def Let_def
    using cnf_BigAnd[of ?fs]
    by force
  ultimately show ?thesis
    by simp
qed

― ‹ A simplification lemma for the above one. ›
(* TODO Replace above lemma with this?. *)
corollary cnf_of_encode_goal_state_set_ii:
  assumes "is_valid_problem_strips Π"
  shows "cnf ((ΦG Π) t) = ({{{ literal_formula_to_literal
      (encode_state_variable t (index (strips_problem.variables_of Π) v) (((Π)G) v)) }}
    | v. v  set ((Π)𝒱)  ((Π)G) v  None })"
proof -
  let ?vs = "strips_problem.variables_of Π"
    and ?G = "(Π)G"
    and G = "(ΦG Π) t"
  {
    fix v
    assume "v  { v | v. v  set ((Π)𝒱)  ?G v  None }"
    then have "v  set ((Π)𝒱)" and G_of_v_is_not_None: "?G v  None"
      by fast+
    then consider (A) "?G v = Some True"
      | (B) "?G v = Some False"
      by fastforce
    hence "cnf (encode_state_variable t (index ?vs v) (?G v))
      = {{ literal_formula_to_literal (encode_state_variable t (index ?vs v) (?G v))  }}"
      unfolding encode_state_variable_def
      by (cases, force+)
  } note nb = this
  have  "cnf G = ({ cnf (encode_state_variable t (index ?vs v) (?G v))
    | v. v  set ((Π)𝒱)  ?G v  None })"
    unfolding cnf_of_encode_goal_state_set_i
    by blast
  also have " = ((λv. cnf (encode_state_variable t (index ?vs v) (((Π)G) v)))
    ` { v | v. v  set ((Π)𝒱)  ((Π)G) v  None })"
    using setcompr_eq_image[of
        "λv. cnf (encode_state_variable t (index ?vs v) (((Π)G) v))"
        "λv. v  set ((Π)𝒱)  ((Π)G) v  None"]
    by presburger
  also have " = ((λv. {{ literal_formula_to_literal
      (encode_state_variable t (index ?vs v) (?G v)) }})
    `  { v. v  set ((Π)𝒱)  ((Π)G) v  None })"
    using nb
    by simp
  finally show ?thesis
    unfolding nb
    by auto
qed

― ‹ This lemma essentially states that the cnf for the cnf formula for the encoding has a
clause for each variable whose state is defined in the goal state with the corresponding literal. ›
(* TODO is ‹∃!› still needed? *)
lemma cnf_of_encode_goal_state_set:
  fixes Π:: "'a strips_problem"
  assumes "is_valid_problem_strips Π"
    and "v  dom ((Π)G)"
  shows "((Π)G) v = Some True  (∃!C. C  cnf ((ΦG Π) t)
       C = { (State t (index (strips_problem.variables_of Π) v))+ })"
    and "((Π)G) v = Some False  (∃!C. C  cnf ((ΦG Π) t)
       C = { (State t (index (strips_problem.variables_of Π) v))¯ })"
proof -
  let ?vs = "strips_problem.variables_of Π"
    and ?G = "(Π)G"
    and G = "(ΦG Π) t"
  have nb1: "cnf G  =  { cnf (encode_state_variable t (index ?vs v)
      (?G v)) | v. v  set ((Π)𝒱)  ?G v  None }"
    unfolding cnf_of_encode_goal_state_set_i
    by auto
  have nb2: "v  { v. v  set ((Π)𝒱)  ?G v  None }"
    using is_valid_problem_dom_of_goal_state_is assms(1, 2)
    by auto
  have nb3: "cnf (encode_state_variable t (index (strips_problem.variables_of Π) v) (((Π)G) v))
     ({ cnf (encode_state_variable t (index ?vs v)
      (?G v)) | v. v  set ((Π)𝒱)  ?G v  None })"
    using UN_upper[OF nb2, of "λv. cnf (encode_state_variable t (index ?vs v) (?G v))"] nb2
    by blast
  show "((Π)G) v = Some True  (∃!C. C  cnf ((ΦG Π) t)
       C = { (State t (index (strips_problem.variables_of Π) v))+ })"
    and "((Π)G) v = Some False  (∃!C. C  cnf ((ΦG Π) t)
       C = { (State t (index (strips_problem.variables_of Π) v))¯ })"
    using nb3
    unfolding nb1 encode_state_variable_def
    by auto+
qed

end


text ‹ We omit the proofs that the partial encoding functions produce formulas in CNF form due to
their more technical nature.
The following sublocale proof confirms that definition \ref{isadef:encode-problem-sat-plan-base}
encodes a valid problem termΠ into a formula that can be transformed to CNF
(term‹is_cnf (Φ Π t)) and that its CNF has the required form. ›


subsection "Soundness of the Basic SATPlan Algorithm"


lemma valuation_models_encoding_cnf_formula_equals:
  assumes "is_valid_problem_strips Π"
  shows "𝒜  Φ Π t = cnf_semantics 𝒜 (cnf (Φ Π t))"
proof -
  let  = "Φ Π t"
  {
    have "is_cnf "
      using is_cnf_encode_problem[OF assms].
    hence "is_nnf "
      using is_nnf_cnf
      by blast
  }
  thus ?thesis
    using cnf_semantics[of  𝒜]
    by blast
qed

(* TODO refactor *)
corollary valuation_models_encoding_cnf_formula_equals_corollary:
  assumes "is_valid_problem_strips Π"
  shows "𝒜  (Φ Π t)
    = (C  cnf (Φ Π t). L  C. lit_semantics 𝒜 L)"
  using valuation_models_encoding_cnf_formula_equals[OF assms]
  unfolding cnf_semantics_def clause_semantics_def encode_problem_def
  by presburger

― ‹ A couple of technical lemmas about decode_plan›. ›
lemma decode_plan_length:
  assumes "π = Φ¯ Π ν t"
  shows "length π = t"
  using assms
  unfolding decode_plan_def SAT_Plan_Base.decode_plan_def
  by simp

lemma decode_plan'_set_is[simp]:
  "set (decode_plan' Π 𝒜 k)
    = { (strips_problem.operators_of Π) ! (index (strips_problem.operators_of Π) op)
      | op. op  set (strips_problem.operators_of Π)
         𝒜 (Operator k (index (strips_problem.operators_of Π) op)) }"
proof -
  let ?ops = "strips_problem.operators_of Π"
  let ?f = "λop. Operator k (index ?ops op)"
  let ?vs = "map ?f ?ops"
  {
    have "set (filter 𝒜 ?vs) = set (map ?f (filter (𝒜  ?f) ?ops))"
      unfolding filter_map[of 𝒜 "λop. Operator k (index ?ops op)" ?ops]..
    hence "set (filter 𝒜 ?vs) = (λop. Operator k (index ?ops op)) `
      { op  set ?ops. 𝒜 (Operator k (index ?ops op)) }"
      unfolding set_map set_filter
      by simp
  }
  have "set (decode_plan' Π 𝒜 k) = (λv. case v of Operator k i  ?ops ! i)
    ` (λop. Operator k (index ?ops op)) ` { op  set ?ops. 𝒜 (Operator k (index ?ops op)) }"
    unfolding decode_plan'_def set_map Let_def
    by auto
  also have " = (λop. case Operator k (index ?ops op) of Operator k i  ?ops ! i)
    ` { op  set ?ops. 𝒜 (Operator k (index ?ops op)) }"
    unfolding image_comp comp_apply
    by argo
  also have " = (λop. ?ops ! (index ?ops op))
    ` { op  set ?ops. 𝒜 (Operator k (index ?ops op)) }"
    by force
  finally show ?thesis
    by blast
qed

lemma decode_plan_set_is[simp]:
  "set (Φ¯ Π 𝒜 t) = (k  {..<t}. { decode_plan' Π 𝒜 k })"
  unfolding decode_plan_def SAT_Plan_Base.decode_plan_def set_map
  using atLeast_upt
  by blast

lemma decode_plan_step_element_then_i:
  assumes "k < t"
  shows "set ((Φ¯ Π 𝒜 t) ! k)
    = { (strips_problem.operators_of Π) ! (index (strips_problem.operators_of Π) op)
      | op. op  set ((Π)𝒪)  𝒜 (Operator k (index (strips_problem.operators_of Π) op)) }"
proof -
  have "(Φ¯ Π 𝒜 t) ! k = decode_plan' Π 𝒜 k"
    unfolding decode_plan_def SAT_Plan_Base.decode_plan_def
    using assms
    by simp
  thus ?thesis
    by force
qed

― ‹ Show that each operator $op$ in the $k$-th parallel operator in a decoded parallel plan is
contained within the problem's operator set and the valuation is true for the corresponding SATPlan
variable. ›
lemma decode_plan_step_element_then:
  fixes Π::"'a strips_problem"
  assumes "k < t"
    and "op  set ((Φ¯ Π 𝒜 t) ! k)"
  shows "op  set ((Π)𝒪)"
    and "𝒜 (Operator k (index (strips_problem.operators_of Π) op))"
proof -
  let ?ops = "strips_problem.operators_of Π"
  let ?Ops = "{ ?ops ! (index ?ops op)
    | op. op  set ((Π)𝒪)  𝒜 (Operator k (index ?ops op)) }"
  have "op  ?Ops"
    using assms(2)
    unfolding decode_plan_step_element_then_i[OF assms(1)] assms
    by blast
  moreover have "op  set ((Π)𝒪)"
    and "𝒜 (Operator k (index ?ops op))"
    using calculation
    by fastforce+
  ultimately show "op  set ((Π)𝒪)"
    and "𝒜 (Operator k (index ?ops op))"
    by blast+
qed

― ‹ Show that the k›-th parallel operators of the decoded plan are distinct lists (i.e. do not
contain duplicates). ›
lemma decode_plan_step_distinct:
  assumes "k < t"
  shows "distinct ((Φ¯ Π 𝒜 t) ! k)"
proof -
  let ?ops = "strips_problem.operators_of Π"
    and k = "(Φ¯ Π 𝒜 t) ! k"
  let ?f = "λop. Operator k (index ?ops op)"
    and ?g = "λv. case v of Operator _ k  ?ops ! k"
  let ?vs = "map ?f (remdups ?ops)"
  have nb1: "k = decode_plan' Π 𝒜 k"
    unfolding decode_plan_def SAT_Plan_Base.decode_plan_def
    using assms
    by fastforce
  {
    have "distinct (remdups ?ops)"
      by blast
    moreover have "inj_on ?f (set (remdups ?ops))"
      unfolding inj_on_def
      by fastforce
    ultimately have "distinct ?vs"
      using distinct_map
      by blast
  } note nb2 = this
  {
    have "inj_on ?g (set ?vs)"
      unfolding inj_on_def
      by fastforce
    hence "distinct (map ?g ?vs)"
      using distinct_map nb2
      by blast
  }
  thus ?thesis
    using distinct_map_filter[of ?g ?vs 𝒜]
    unfolding nb1 decode_plan'_def Let_def
    by argo
qed

lemma decode_state_at_valid_variable:
  fixes Π :: "'a strips_problem"
  assumes "(ΦS¯ Π 𝒜 k) v  None"
  shows "v  set ((Π)𝒱)"
proof -
  let ?vs = "strips_problem.variables_of Π"
  let ?f = "λv. (v,𝒜 (State k (index ?vs v)))"
  {
    have "fst ` set (map ?f ?vs) = fst ` (λv. (v,𝒜 (State k (index ?vs v)))) ` set ?vs"
      by force
    also have " = (λv. fst (v,𝒜 (State k (index ?vs v)))) ` set ?vs"
      by blast
    finally have "fst ` set (map ?f ?vs) = set ?vs"
      by auto
  }
  moreover have "¬v  fst ` set (map ?f ?vs)"
    using map_of_eq_None_iff[of "map ?f ?vs" v] assms
    unfolding decode_state_at_def SAT_Plan_Base.decode_state_at_def
    by meson
  ultimately show ?thesis
    by fastforce
qed

― ‹ Show that there exists an equivalence between a model 𝒜› of the (CNF of the) encoded
problem and the state at step k› decoded from the encoded problem. ›
lemma decode_state_at_encoding_variables_equals_some_of_valuation_if:
  fixes Π:: "'a strips_problem"
  assumes "is_valid_problem_strips Π"
    and "𝒜  Φ Π t"
    and "k  t"
    and "v  set ((Π)𝒱)"
  shows "(ΦS¯ Π 𝒜 k) v
    = Some (𝒜 (State k (index (strips_problem.variables_of Π) v)))"
proof -
  let ?vs = "strips_problem.variables_of Π"
  let ?l = "map (λx. (x,𝒜 (State k (index ?vs x)))) ?vs"
  have "set ?vs  {}"
    using assms(4)
    by fastforce
  then have "map_of ?l v = Some (𝒜 (State k (index ?vs v)))"
    using map_of_from_function_graph_is_some_if[of ?vs v
        "λv. 𝒜 (State k (index ?vs v))"] assms(4)
    by fastforce
  thus ?thesis
    unfolding decode_state_at_def SAT_Plan_Base.decode_state_at_def
    by meson
qed

lemma decode_state_at_dom:
  assumes "is_valid_problem_strips Π"
  shows "dom (ΦS¯ Π 𝒜 k) = set ((Π)𝒱)"
proof-
  let ?s = "ΦS¯ Π 𝒜 k"
    and ?vs = "strips_problem.variables_of Π"
  have "dom ?s = fst ` set (map (λv. (v, 𝒜 (State k (index ?vs v)))) ?vs)"
    unfolding decode_state_at_def SAT_Plan_Base.decode_state_at_def
    using dom_map_of_conv_image_fst[of "(map (λv. (v, 𝒜 (State k (index ?vs v)))) ?vs)"]
    by meson
  also have " = fst ` (λv. (v, 𝒜 (State k (index ?vs v)))) ` set ((Π)𝒱)"
    using set_map[of "(λv. (v, 𝒜 (State k (index ?vs v))))" ?vs]
    by simp
  also have " = (fst  (λv. (v, 𝒜 (State k (index ?vs v))))) ` set ((Π)𝒱)"
    using image_comp[of fst "(λv. (v, 𝒜 (State k (index ?vs v))))"]
    by presburger
  finally show ?thesis
    by force
qed

(* TODO shorten the proof (there are a lot of duplicate parts still!). *)
lemma decode_state_at_initial_state:
  assumes "is_valid_problem_strips Π"
    and "𝒜  Φ Π t"
  shows "(ΦS¯ Π 𝒜 0) = (Π)I"
proof -
  let ?I = "(Π)I"
  let ?s = "ΦS¯ Π 𝒜 0"
  let ?vs = "strips_problem.variables_of Π"
  let  = "Φ Π t"
  let I = "ΦI Π"
  {
    have "is_cnf I" and "cnf I  cnf "
      subgoal
        using is_cnf_encode_initial_state[OF assms(1)]
        by simp
      subgoal
        using cnf_of_encode_problem_structure(1)
        unfolding encode_initial_state_def encode_problem_def
        by blast
      done
    then have "cnf_semantics 𝒜 (cnf I)"
      using cnf_semantics_monotonous_in_cnf_subsets_if is_cnf_encode_problem[OF assms(1)]
        assms(2)
      by blast
    hence "C  cnf I. clause_semantics 𝒜 C"
      unfolding cnf_semantics_def encode_initial_state_def
      by blast
  } note nb1 = this
  {
    (* TODO refactor. *)
    {
      fix v
      assume v_in_dom_i: "v  dom ?I"
      moreover  {
        have v_in_variable_set: "v  set ((Π)𝒱)"
          using is_valid_problem_strips_initial_of_dom assms(1) v_in_dom_i
          by auto
        hence "(ΦS¯ Π 𝒜 0) v = Some (𝒜 (State 0 (index ?vs v)))"
          using decode_state_at_encoding_variables_equals_some_of_valuation_if[OF
              assms(1, 2) _ v_in_variable_set]
          by fast
      } note nb2 = this
      consider (v_initially_true) "?I v = Some True"
        | (v_initially_false) "?I v = Some False"
        using v_in_dom_i
        by fastforce
      hence "?I v = ?s v"
        proof (cases)
          case v_initially_true
          then obtain C
            where "C  cnf I"
              and c_is: "C = { (State 0 (index ?vs v))+ }"
            using cnf_of_encode_initial_state_set v_in_dom_i assms(1)
            by fastforce
          hence "𝒜 (State 0 (index ?vs v)) = True"
            using nb1
            unfolding clause_semantics_def
            by fastforce
          thus ?thesis
            using nb2 v_initially_true
            by presburger
        next
          case v_initially_false
          (* TODO slow *)
          then obtain C
            where "C  cnf I"
              and c_is: "C = { (State 0 (index ?vs v))¯ }"
            using cnf_of_encode_initial_state_set assms(1) v_in_dom_i
            by fastforce
          hence "𝒜 (State 0 (index ?vs v)) = False"
            using nb1
            unfolding clause_semantics_def
            by fastforce
          thus ?thesis
            using nb2 v_initially_false
            by presburger
        qed
    }
    hence "?I m ?s"
      using map_le_def
      by blast
  } moreover {
    {
      fix v
      assume v_in_dom_s: "v  dom ?s"
      then have v_in_set_vs: "v  set ?vs"
        using decode_state_at_dom[OF assms(1)]
        by simp
      have v_in_dom_I: "v  dom ?I"
        using is_valid_problem_strips_initial_of_dom assms(1) v_in_set_vs
        by auto
      have s_v_is: "(ΦS¯ Π 𝒜 0) v = Some (𝒜 (State 0 (index ?vs v)))"
        using decode_state_at_encoding_variables_equals_some_of_valuation_if assms(1, 2)
          v_in_set_vs
        by (metis le0)
      consider (s_v_is_some_true) "?s v = Some True"
        | (s_v_is_some_false) "?s v = Some False"
        using v_in_dom_s
        by fastforce
      hence "?s v = ?I v"
        proof (cases)
          case s_v_is_some_true
          then have 𝒜_of_s_v: "lit_semantics 𝒜 ((State 0 (index ?vs v))+)"
            using s_v_is
            by fastforce
          consider (I_v_is_some_true) "?I v = Some True"
            | (I_v_is_some_false) "?I v = Some False"
            using v_in_dom_I
            by fastforce
          thus ?thesis
            proof (cases)
              case I_v_is_some_true
              then show ?thesis
                using s_v_is_some_true
                by argo
            next
              case I_v_is_some_false
              (* TODO slow *)
              then obtain C
                where C_in_encode_initial_state: "C  cnf I"
                  and C_is: "C = { (State 0 (index ?vs v))¯  }"
                using cnf_of_encode_initial_state_set assms(1) v_in_dom_I
                by fastforce
              hence "lit_semantics 𝒜 ((State 0 (index ?vs v))¯)"
                using nb1
                unfolding clause_semantics_def
                by fast
              thus ?thesis
                using 𝒜_of_s_v
                by fastforce
            qed
        next
          case s_v_is_some_false
          then have 𝒜_of_s_v: "lit_semantics 𝒜 ((State 0 (index ?vs v))¯)"
            using s_v_is
            by fastforce
          consider (I_v_is_some_true) "?I v = Some True"
            | (I_v_is_some_false) "?I v = Some False"
            using v_in_dom_I
            by fastforce
          thus ?thesis
            proof (cases)
              case I_v_is_some_true
              then obtain C
                where C_in_encode_initial_state: "C  cnf I"
                  and C_is: "C = { (State 0 (index ?vs v))+  }"
                using cnf_of_encode_initial_state_set assms(1) v_in_dom_I
                by fastforce
              hence "lit_semantics 𝒜 ((State 0 (index ?vs v))+)"
                using nb1
                unfolding clause_semantics_def
                by fast
              thus ?thesis
                using 𝒜_of_s_v
                by fastforce
            next
              case I_v_is_some_false
              thus ?thesis
                using s_v_is_some_false
                by presburger
            qed
        qed
    }
    hence "?s m ?I"
      using map_le_def
      by blast
  } ultimately show ?thesis
    using map_le_antisym
    by blast
qed

lemma decode_state_at_goal_state:
  assumes "is_valid_problem_strips Π"
    and "𝒜  Φ Π t"
  shows "(Π)G m ΦS¯ Π 𝒜 t"
proof -
  let ?vs = "strips_problem.variables_of Π"
    and ?G = "(Π)G"
    and ?G' = "ΦS¯ Π 𝒜 t"
    and  = "Φ Π t"
    and G = "(ΦG Π) t"
  {
    have "is_cnf G" and "cnf G  cnf "
      subgoal
        using encode_goal_state_is_cnf[OF assms(1)]
        by simp
      subgoal
        using cnf_of_encode_problem_structure(2)
        unfolding encode_goal_state_def encode_problem_def
        by blast
      done
    then have "cnf_semantics 𝒜 (cnf G)"
      using cnf_semantics_monotonous_in_cnf_subsets_if is_cnf_encode_problem[OF assms(1)]
        assms(2)
      by blast
    hence "C  cnf G. clause_semantics 𝒜 C"
      unfolding cnf_semantics_def encode_initial_state_def
      by blast
  } note nb1 = this
  (* TODO refactor. *)
  {
    fix v
    assume "v  set ((Π)𝒱)"
    moreover have "set ?vs  {}"
      using calculation(1)
      by fastforce
    moreover have "(ΦS¯ Π 𝒜 t)
      = map_of (map (λv. (v, 𝒜 (State t (index ?vs v)))) ?vs)"
      unfolding decode_state_at_def SAT_Plan_Base.decode_state_at_def
      by metis
    (* TODO slow. *)
    ultimately have "(ΦS¯ Π 𝒜 t) v = Some (𝒜 (State t (index ?vs v)))"
      using map_of_from_function_graph_is_some_if
      by fastforce
  } note nb2 = this
  {
    fix v
    assume v_in_dom_G: "v  dom ?G"
    then have v_in_vs: "v  set ?vs"
      using is_valid_problem_dom_of_goal_state_is assms(1)
      by auto
    then have decode_state_at_is: "(ΦS¯ Π 𝒜 t) v = Some (𝒜 (State t (index ?vs v)))"
      using nb2
      by fastforce
    consider (A) "?G v = Some True"
      | (B) "?G v = Some False"
      using v_in_dom_G
      by fastforce
    hence "?G v = ?G' v"
      proof (cases)
        case A
        {
          obtain C where "C  cnf G" and "C = {{ (State t (index ?vs v))+ }}"
            using cnf_of_encode_goal_state_set(1)[OF assms(1) v_in_dom_G] A
            by auto
          then have "{ (State t (index ?vs v))+ }  cnf G"
            by blast
          then have "clause_semantics 𝒜 { (State t (index ?vs v))+ }"
            using nb1
            by blast
          then have "lit_semantics 𝒜 ((State t (index ?vs v))+)"
            unfolding clause_semantics_def
            by blast
          hence "𝒜 (State t (index ?vs v)) = True"
            by force
        }
        thus ?thesis
          using decode_state_at_is A
          by presburger
      next
        case B
        {
          obtain C where "C  cnf G" and "C = {{ (State t (index ?vs v))¯ }}"
            using cnf_of_encode_goal_state_set(2)[OF assms(1) v_in_dom_G] B
            by auto
          then have "{ (State t (index ?vs v))¯ }  cnf G"
            by blast
          then have "clause_semantics 𝒜 { (State t (index ?vs v))¯ }"
            using nb1
            by blast
          then have "lit_semantics 𝒜 ((State t (index ?vs v))¯)"
            unfolding clause_semantics_def
            by blast
          hence "𝒜 (State t (index ?vs v)) = False"
            by simp
        }
        thus ?thesis
          using decode_state_at_is B
          by presburger
    qed
  }
  thus ?thesis
    using map_le_def
    by blast
qed

― ‹ Show that the operator activation implies precondition constraints hold at every time step
of the decoded plan. ›
lemma decode_state_at_preconditions:
  assumes "is_valid_problem_strips Π"
    and "𝒜  Φ Π t"
    and "k < t"
    and "op  set ((Φ¯ Π 𝒜 t) ! k)"
    and "v  set (precondition_of op)"
  shows "𝒜 (State k (index (strips_problem.variables_of Π) v))"
proof -
  let ?ops = "strips_problem.operators_of Π"
    and ?vs = "strips_problem.variables_of Π"
  let  = "Φ Π t"
    and O = "encode_operators Π t"
    and P = "encode_all_operator_preconditions Π ?ops t"
  {
    have "𝒜 (Operator k (index ?ops op))"
      and "op  set ((Π)𝒪)"
      using decode_plan_step_element_then[OF assms(3, 4)]
      by blast+
    moreover obtain C
      where clause_is_in_operator_encoding: "C  cnf P"
        and "C = { (Operator k (index ?ops op))¯,
        (State k (index ?vs v))+ }"
      using cnf_of_encode_all_operator_preconditions_contains_clause_if[OF assms(1, 3)
          calculation(2) assms(5)]
      by blast
    moreover have clause_semantics_𝒜_ΦP: "C  cnf P. clause_semantics 𝒜 C"
      using cnf_semantics_monotonous_in_cnf_subsets_if[OF assms(2)
          is_cnf_encode_problem[OF assms(1)]
        cnf_of_operator_precondition_encoding_subset_encoding]
      unfolding cnf_semantics_def
      by blast
    (* TODO slow step *)
    ultimately have "lit_semantics 𝒜 (Pos (State k (index ?vs v)))"
      unfolding clause_semantics_def
      by fastforce
  }
  thus ?thesis
    unfolding lit_semantics_def
    by fastforce
qed

― ‹ This lemma shows that for a problem encoding with makespan zero for which a model exists,
the goal state encoding must be subset of the initial state encoding. In this case, the state
variable encodings for the goal state are included in the initial state encoding. ›
(* TODO simplify/refactor proof. *)
lemma encode_problem_parallel_correct_i:
  assumes "is_valid_problem_strips Π"
    and "𝒜  Φ Π 0"
  shows "cnf ((ΦG Π) 0)  cnf (ΦI Π)"
proof -
  let ?vs = "strips_problem.variables_of Π"
    and ?I = "(Π)I"
    and ?G = "(Π)G"
    and I = "ΦI Π"
    and G = "(ΦG Π) 0"
    and  = "Φ Π 0"
  (* TODO refactor and generalize for all partial encodings? *)
  ― ‹ Show that the model of the encoding is also a model of the partial encodings. ›
  have 𝒜_models_ΦI: "𝒜  I" and 𝒜_models_ΦG: "𝒜  G"
    using assms(2) encode_problem_has_model_then_also_partial_encodings(1, 2)
    unfolding encode_problem_def encode_initial_state_def encode_goal_state_def
    by blast+
  ― ‹ Show that every clause in the CNF of the goal state encoding @{text G"} is also in
  the CNF of the initial state encoding @{text I"} thus making it a subset. We can conclude this
  from the fact that both @{text I"} and @{text G"} contain singleton clauses—which must all
  be evaluated to true by the given model 𝒜›—and the similar structure of the clauses in both
  partial encodings.

  By extension, if we decode the goal state @{text "G"} and the initial state @{text "I"} from a
  model of the encoding,  @{text "G v = I v"} must hold for variable @{text "v"} in the domain of
  the goal state. ›
  {
    fix C'
    assume C'_in_cnf_ΦG: "C'  cnf G"
    then obtain v
      where v_in_vs: "v  set ?vs"
        and G_of_v_is_not_None: "?G v  None"
        and C'_is: "C' = { literal_formula_to_literal (encode_state_variable 0 (index ?vs v)
          (?G v)) }"
      using cnf_of_encode_goal_state_set_ii[OF assms(1)]
      by auto
    obtain C
      where C_in_cnf_ΦI: "C  cnf I"
        and C_is: "C = { literal_formula_to_literal (encode_state_variable 0 (index ?vs v)
          (?I v)) }"
      using cnf_of_encode_initial_state_set_ii[OF assms(1)] v_in_vs
      by auto
    {
      let ?L = "literal_formula_to_literal (encode_state_variable 0 (index ?vs v) (?I v))"
      have "{ ?L }  cnf I"
        using C_in_cnf_ΦI C_is
        by blast
      hence "lit_semantics 𝒜 ?L"
        using model_then_all_singleton_clauses_modelled[OF
            is_cnf_encode_initial_state[OF assms(1)]_ 𝒜_models_ΦI]
        by blast
    } note lit_semantics_𝒜_L = this
    {
      let ?L' = "literal_formula_to_literal (encode_state_variable 0 (index ?vs v) (?G v))"
      have "{ ?L' }  cnf G"
        using C'_in_cnf_ΦG C'_is
        by blast
      hence "lit_semantics 𝒜 ?L'"
        using model_then_all_singleton_clauses_modelled[OF
            encode_goal_state_is_cnf[OF assms(1)]_ 𝒜_models_ΦG]
        by blast
    } note lit_semantics_𝒜_L' = this
    {
      have "?I v = ?G v"
        proof (rule ccontr)
          assume contradiction: "?I v  ?G v"
          moreover have "?I v  None"
            using v_in_vs is_valid_problem_strips_initial_of_dom assms(1)
            by auto
          ultimately consider (A) "?I v = Some True  ?G v = Some False"
            | (B) "?I v = Some False  ?G v = Some True"
            using G_of_v_is_not_None
            by force
          thus False
            using lit_semantics_𝒜_L lit_semantics_𝒜_L'
            unfolding encode_state_variable_def
            by (cases, fastforce+)
        qed
    }
    hence "C'  cnf I"
      using C_is C_in_cnf_ΦI C'_is C'_in_cnf_ΦG
      by argo
  }
  thus ?thesis
    by blast
qed

― ‹ Show that the encoding secures that for every parallel operator ops›
decoded from the plan at every time step t < length pi› the following hold:
\begin{enumerate}
\item  ops› is applicable, and
\item the effects of ops› are consistent.
\end{enumerate}›
lemma encode_problem_parallel_correct_ii:
  assumes "is_valid_problem_strips Π"
    and "𝒜  Φ Π t"
    and "k < length (Φ¯ Π 𝒜 t)"
  shows "are_all_operators_applicable (ΦS¯ Π 𝒜 k)
    ((Φ¯ Π 𝒜 t) ! k)"
    and "are_all_operator_effects_consistent ((Φ¯ Π 𝒜 t) ! k)"
proof -
  let ?vs = "strips_problem.variables_of Π"
    and ?ops = "strips_problem.operators_of Π"
    and  = "Φ¯ Π 𝒜 t"
    and ?s = "ΦS¯ Π 𝒜 k"
  let  = "Φ Π t"
    and E = "encode_all_operator_effects Π ?ops t"
  have k_lt_t: "k < t"
    using decode_plan_length assms(3)
    by metis
  {
    {
      fix op v
      assume op_in_kth_of_decoded_plan_set: "op  set ( ! k)"
        and v_in_precondition_set: "v  set (precondition_of op)"
      {
        have "𝒜 (Operator k (index ?ops op))"
          using decode_plan_step_element_then[OF k_lt_t op_in_kth_of_decoded_plan_set]
          by blast
        hence "𝒜 (State k (index ?vs v))"
          using decode_state_at_preconditions[
              OF assms(1, 2) _ op_in_kth_of_decoded_plan_set v_in_precondition_set] k_lt_t
          by blast
      }
      moreover have "k  t"
        using k_lt_t
        by auto
      moreover {
        have "op  set ((Π)𝒪)"
          using decode_plan_step_element_then[OF k_lt_t op_in_kth_of_decoded_plan_set]
          by simp
        then have  "v  set ((Π)𝒱)"
          using is_valid_problem_strips_operator_variable_sets(1) assms(1)
            v_in_precondition_set
          by auto
      }
      ultimately have "(ΦS¯ Π 𝒜 k) v = Some True"
        using decode_state_at_encoding_variables_equals_some_of_valuation_if[OF assms(1, 2)]
        by presburger
    }
    hence "are_all_operators_applicable ?s ( ! k)"
      using are_all_operators_applicable_set[of ?s " ! k"]
      by blast
  } moreover {
    {
      fix op1 op2
      assume op1_in_k_th_of_decoded_plan: "op1  set ((Φ¯ Π 𝒜 t) ! k)"
        and op2_in_k_th_of_decoded_plan: "op2  set ((Φ¯ Π 𝒜 t) ! k)"
      have op1_in_set_ops: "op1  set ((Π)𝒪)"
        and op2_in_set_ops: "op2  set ((Π)𝒪)"
        and op1_active_at_k: "¬lit_semantics 𝒜 ((Operator k (index ?ops op1))¯)"
        and op2_active_at_k: "¬lit_semantics 𝒜 ((Operator k (index ?ops op2))¯)"
        subgoal
          using decode_plan_step_element_then[OF k_lt_t op1_in_k_th_of_decoded_plan]
          by simp
        subgoal
          using decode_plan_step_element_then[OF k_lt_t op2_in_k_th_of_decoded_plan]
          by force
        subgoal
          using decode_plan_step_element_then[OF k_lt_t op1_in_k_th_of_decoded_plan]
          by simp
        subgoal
          using decode_plan_step_element_then[OF k_lt_t op2_in_k_th_of_decoded_plan]
          by simp
        done
      (* TODO the following two blocks could be contracted and refactored into a single lemma. *)
      {
        fix v
        assume v_in_add_effects_set_of_op1: "v  set (add_effects_of op1)"
          and  v_in_delete_effects_set_of_op2: "v  set (delete_effects_of op2)"
        let ?C1 = "{(Operator k (index ?ops op1))¯,
          (State (Suc k) (index ?vs v))+}"
          and ?C2 = "{(Operator k (index ?ops op2))¯,
          (State (Suc k) (index ?vs v))¯}"
        have "?C1  cnf E" and "?C2  cnf E"
          subgoal
            using cnf_of_operator_effect_encoding_contains_add_effect_clause_if[OF
                assms(1) k_lt_t op1_in_set_ops v_in_add_effects_set_of_op1]
            by blast
          subgoal
            using cnf_of_operator_effect_encoding_contains_delete_effect_clause_if[OF
                assms(1) k_lt_t op2_in_set_ops v_in_delete_effects_set_of_op2]
            by blast
          done
        then have "?C1  cnf " and "?C2  cnf "
          using cnf_of_encode_all_operator_effects_subset_cnf_of_encode_problem
          by blast+
        then have C1_true: "clause_semantics 𝒜 ?C1" and C2_true: "clause_semantics 𝒜 ?C2"
          using valuation_models_encoding_cnf_formula_equals[OF assms(1)] assms(2)
          unfolding cnf_semantics_def
          by blast+
        have "lit_semantics 𝒜 ((State (Suc k) (index ?vs v))+)"
          and "lit_semantics 𝒜 ((State (k + 1) (index ?vs v))¯)"
          subgoal
            using op1_active_at_k C1_true
            unfolding clause_semantics_def
            by blast
          subgoal
            using op2_active_at_k C2_true
            unfolding clause_semantics_def
            by fastforce
          done
        hence False
          by auto
      } moreover {
        fix v
        assume v_in_delete_effects_set_of_op1: "v  set (delete_effects_of op1)"
          and  v_in_add_effects_set_of_op2: "v  set (add_effects_of op2)"
        let ?C1 = "{(Operator k (index ?ops op1))¯, (State (Suc k) (index ?vs v))¯}"
          and ?C2 = "{(Operator k (index ?ops op2))¯, (State (Suc k) (index ?vs v))+}"
        have "?C1  cnf E" and "?C2  cnf E"
          subgoal
            using cnf_of_operator_effect_encoding_contains_delete_effect_clause_if[OF
                assms(1) k_lt_t op1_in_set_ops v_in_delete_effects_set_of_op1]
            by fastforce
          subgoal
            using cnf_of_operator_effect_encoding_contains_add_effect_clause_if[OF
                assms(1) k_lt_t op2_in_set_ops v_in_add_effects_set_of_op2]
            by simp
          done
        then have "?C1  cnf " and "?C2  cnf "
          using cnf_of_encode_all_operator_effects_subset_cnf_of_encode_problem
          by blast+
        then have C1_true: "clause_semantics 𝒜 ?C1" and C2_true: "clause_semantics 𝒜 ?C2"
          using valuation_models_encoding_cnf_formula_equals[OF assms(1)] assms(2)
          unfolding cnf_semantics_def
          by blast+
        have "lit_semantics 𝒜 ((State (Suc k) (index ?vs v))¯)"
          and "lit_semantics 𝒜 ((State (k + 1) (index ?vs v))+)"
          subgoal
            using op1_active_at_k C1_true
            unfolding clause_semantics_def
            by blast
          subgoal
            using op2_active_at_k  C2_true
            unfolding clause_semantics_def
            by fastforce
          done
        hence False
          by simp
      }
      ultimately have "set (add_effects_of op1)  set (delete_effects_of op2) = {}"
        and "set (delete_effects_of op1)  set (add_effects_of op2) = {}"
        by blast+
    }
    hence "are_all_operator_effects_consistent ( ! k)"
      using are_all_operator_effects_consistent_set[of " ! k"]
      by blast
  }
  ultimately show "are_all_operators_applicable ?s ( ! k)"
    and "are_all_operator_effects_consistent ( ! k)"
    by blast+
qed

― ‹ Show that for all operators op› at timestep k› of the plan
Φ¯ Π 𝒜 t› decoded from the model 𝒜›, both add effects as
well as delete effects will hold in the next timestep Suc k›. ›
lemma encode_problem_parallel_correct_iii:
  assumes "is_valid_problem_strips Π"
    and "𝒜  Φ Π t"
    and "k < length (Φ¯ Π 𝒜 t)"
    and "op  set ((Φ¯ Π 𝒜 t) ! k)"
  shows "v  set (add_effects_of op)
     (ΦS¯ Π 𝒜 (Suc k)) v = Some True"
  and "v  set (delete_effects_of op)
     (ΦS¯ Π 𝒜 (Suc k)) v = Some False"
proof -
  let ?ops = "strips_problem.operators_of Π"
    and ?vs = "strips_problem.variables_of Π"
  let F = "encode_all_operator_effects Π ?ops t"
    and ?A = "((t, op){0..<t} × set ((Π)𝒪).
      {{{ (Operator t (index ?ops op))¯, (State (Suc t) (index ?vs v))+ }}
        | v. v  set (add_effects_of op)})"
    and ?B = "((t, op){0..<t} × set ((Π)𝒪).
       {{{ (Operator t (index ?ops op))¯,
          (State (Suc t) (index ?vs v))¯ }}
        | v. v  set (delete_effects_of op)})"
  have k_lt_t: "k < t"
    using decode_plan_length assms(3)
    by metis
  have op_is_valid: "op  set ((Π)𝒪)"
    using decode_plan_step_element_then[OF k_lt_t assms(4)]
    by blast
  have k_op_included: "(k, op)  ({0..<t} × set ((Π)𝒪))"
    using k_lt_t op_is_valid
    by fastforce
  thus  "v  set (add_effects_of op)
     (ΦS¯ Π 𝒜 (Suc k)) v = Some True"
    and "v  set (delete_effects_of op)
       (ΦS¯ Π 𝒜 (Suc k)) v = Some False"
    proof (auto)
      assume v_is_add_effect: "v  set (add_effects_of op)"
      have "𝒜 (Operator k (index ?ops op))"
        using decode_plan_step_element_then[OF k_lt_t assms(4)]
        by blast
      moreover {
        have "{{(Operator k (index ?ops op))¯, (State (Suc k) (index ?vs v))+}}
           {{{(Operator k (index ?ops op))¯, (State (Suc k) (index ?vs v))+}}
            | v. v  set (add_effects_of op)}"
          using v_is_add_effect
          by blast
        (* TODO slow. *)
        then have "{{(Operator k (index ?ops op))¯, (State (Suc k) (index ?vs v))+}}  ?A"
          using k_op_included cnf_of_operator_encoding_structure
            UN_iff[of "{{(Operator t (index ?ops op))¯, (State (Suc t) (index ?vs v))+}}"
              _ "{0..<t} × set ((Π)𝒪)"]
          by blast
        (* TODO slow. *)
        then have "{(Operator k (index ?ops op))¯, (State (Suc k) (index ?vs v))+}   ?A"
          using Union_iff[of "{(Operator k (index ?ops op))¯, (State (Suc k) (index ?vs v))+}"]
          by blast
        (* TODO slow. *)
        moreover have "?A  cnf F"
          using cnf_of_encode_all_operator_effects_structure
          by blast
        ultimately have "{(Operator k (index ?ops op))¯, (State (Suc k) (index ?vs v))+}  cnf F"
          using in_mono[of "?A" "cnf F"]
          by presburger
      }
      (* TODO slow. *)
      ultimately have "𝒜 (State (Suc k) (index ?vs v))"
        using cnf_of_encode_all_operator_effects_subset_cnf_of_encode_problem
              assms(2)[unfolded valuation_models_encoding_cnf_formula_equals_corollary[OF assms(1)]]
        unfolding Bex_def
        by fastforce
      thus "(ΦS¯ Π 𝒜 (Suc k)) v = Some True"
        using assms(1) assms(2)
          decode_state_at_encoding_variables_equals_some_of_valuation_if
          is_valid_problem_strips_operator_variable_sets(2) k_lt_t op_is_valid subsetD
          v_is_add_effect
        by fastforce
    next
      assume v_is_delete_effect: "v  set (delete_effects_of op)"
      have "𝒜 (Operator k (index ?ops op))"
        using decode_plan_step_element_then[OF k_lt_t assms(4)]
        by blast
      moreover {
        have "{{(Operator k (index ?ops op))¯, (State (Suc k) (index ?vs v))¯}}
           {{{(Operator k (index ?ops op))¯, (State (Suc k) (index ?vs v))¯}}
            | v. v  set (delete_effects_of op)}"
          using v_is_delete_effect
          by blast
        (* TODO slow. *)
        then have "{{(Operator k (index ?ops op))¯, (State (Suc k) (index ?vs v))¯}}  ?B"
          using k_op_included cnf_of_encode_all_operator_effects_structure
            UN_iff[of "{{(Operator t (index ?ops op))¯, (State (Suc t) (index ?vs v))+}}"
              _ "{0..<t} × set ((Π)𝒪)"]
          by blast
        (* TODO slow. *)
        then have "{(Operator k (index ?ops op))¯, (State (Suc k) (index ?vs v))¯}   ?B"
          using Union_iff[of "{(Operator k (index ?ops op))¯, (State (Suc k) (index ?vs v))¯}"]
          by blast
        (* TODO slow. *)
        moreover have "?B  cnf F"
          using cnf_of_encode_all_operator_effects_structure Un_upper2[of "?B" "?A"]
          by fast
        ultimately have "{(Operator k (index ?ops op))¯, (State (Suc k) (index ?vs v))¯}  cnf F"
          using in_mono[of "?B" "cnf F"]
          by presburger
      }
      (* TODO slow. *)
      ultimately have "¬𝒜 (State (Suc k) (index ?vs v))"
        using cnf_of_encode_all_operator_effects_subset_cnf_of_encode_problem
          valuation_models_encoding_cnf_formula_equals_corollary[OF assms(1)] assms(2)
        by fastforce
      moreover have "Suc k  t"
        using k_lt_t
        by fastforce
      moreover have "v  set((Π)𝒱)"
        using v_is_delete_effect is_valid_problem_strips_operator_variable_sets(3) assms(1)
            op_is_valid
        by auto
      ultimately show "(ΦS¯ Π 𝒜 (Suc k)) v = Some False"
        using decode_state_at_encoding_variables_equals_some_of_valuation_if[OF assms(1, 2)]
        by auto
    qed
qed

― ‹ In broad strokes, this lemma shows that the operator frame axioms ensure that state is
propagated—i.e. the valuation of a variable does not change inbetween time steps—, if there is
no operator active which has an effect on a given variable a: i.e.

  \begin{align*}
    \mathcal A &\vDash (\lnot a_i \land a_{i+1})
      \longrightarrow \bigvee\{op_i, k: op_i \text{ has add effect } a\}\\
    \mathcal A &\vDash (a_i \land \lnot a_{i+1})
      \longrightarrow \bigvee\{op_i, k: op_i \text{ has delete effect } a\}
  \end{align*}

Now, if the disjunctions are empty—i.e. if no operator which is activated at time step $k$ has
either a positive or negative effect—, we have by simplification

  \begin{align*}
    \mathcal A \vDash \lnot(\lnot a_i \land a_{i+1})
      &\equiv \mathcal A \vDash a_i \lor \lnot a_{i+1}\\
    \mathcal A \vDash \lnot(a_i \land \lnot a_{i+1})
      &\equiv \mathcal A \vDash \lnot a_i \lor a_{i+1}
  \end{align*}

hence

   \begin{align*}
      \mathcal A &\vDash (\lnot a_i \lor a_{i+1}) \land (a_i \lor \lnot a_{i+1})\\
      \leadsto \mathcal A &\vDash \{\{\lnot a_i, a_{i+1}\}, \{a_i, \lnot a_{i+1}\}\}
    \end{align*}

The lemma characterizes this simplification.
\footnote{This part of the soundness proof is only treated very briefly in
\cite[theorem 3.1, p.1044]{DBLP:journals/ai/RintanenHN06}} ›
lemma encode_problem_parallel_correct_iv:
  fixes Π:: "'a strips_problem"
  assumes "is_valid_problem_strips Π"
    and "𝒜  Φ Π t"
    and "k < t"
    and "v  set ((Π)𝒱)"
    and "¬(op  set ((Φ¯ Π 𝒜 t) ! k).
      v  set (add_effects_of op)  v  set (delete_effects_of op))"
  shows "cnf_semantics 𝒜 {{ (State k (index (strips_problem.variables_of Π) v))¯
    , (State (Suc k) (index (strips_problem.variables_of Π) v))+ }}"
    and "cnf_semantics 𝒜 {{ (State k (index (strips_problem.variables_of Π) v))+
      , (State (Suc k) (index (strips_problem.variables_of Π) v))¯ }}"
proof -
  let ?vs = "strips_problem.variables_of Π"
    and ?ops = "strips_problem.operators_of Π"
  let  = "Φ Π t"
    and F = "encode_all_frame_axioms Π t"
    and k = "(Φ¯ Π 𝒜 t) ! k"
    and ?A = "(k, v)  ({0..<t} × set ?vs).
      {{{ (State k (index ?vs v))+, (State (Suc k) (index ?vs v))¯  }
         {(Operator k (index ?ops op))+ | op. op  set ?ops  v  set (add_effects_of op) }}}"
    and ?B = "(k, v)  ({0..<t} × set ?vs).
      {{{ (State k (index ?vs v))¯, (State (Suc k) (index ?vs v))+ }
         { (Operator k (index ?ops op))+ | op. op  set ?ops  v  set (delete_effects_of op) }}}"
    and ?C = "{ (State k (index ?vs v))+, (State (Suc k) (index ?vs v))¯  }
         {(Operator k (index ?ops op))+ | op. op  set ?ops  v  set (add_effects_of op) }"
    and ?C' = "{ (State k (index ?vs v))¯, (State (Suc k) (index ?vs v))+ }
         { (Operator k (index ?ops op))+ | op. op  set ?ops  v  set (delete_effects_of op) }"
    (* TODO refactor (next two blocks)? *)
  have k_v_included: "(k, v)  ({..<t} × set ((Π)𝒱))"
    using assms(3, 4)
    by blast
  have operator_encoding_subset_encoding: "cnf F  cnf "
    using cnf_of_encode_problem_structure(4)
    unfolding encode_problem_def
    by fast
  ― ‹ Given the premise that no operator in πk exists with add-effect respectively delete
effect v›, we have the following situation for the EPC (effect precondition) sets:
  \begin{itemize}
    \item assuming op› is in set ?ops›, either op› is in πk (then it doesn't have effect on v›
      and therefore is not in either of the sets), or if is not, then
      𝒜 (Operator k (index ?ops op) = ⊥› by definition of decode_plan›; moreover,
    \item assuming op› is not in set ?ops›—this is implicitely encoded as Operator k
      (length ?ops)› and 𝒜 (Operator k (length ?ops))› may or may not be true—, then it's not
      in either of the sets.
  \end{itemize}.
Altogether, we have the situation that the sets only have members Operator k (index ?ops op)›
with 𝒜 (Operator k (index ?ops op)) = ⊥›, hence the clause can be reduced to the state
variable literals.

More concretely, the following proof block shows that the following two conditions hold for the
operators:

  @{text[display, indent=4] "∀op. op ∈ { ((Operator k (index ?ops op))+)
      | op. op ∈ set ?ops ∧ v ∈ set (add_effects_of op)}
    ⟶ ¬lit_semantics 𝒜 op" }

and

  @{text[display, indent=4] "∀op. op ∈ { ((Operator k (index ?ops op))+)
      | op. op ∈ set ?ops ∧ v ∈ set (delete_effects_of op)}
    ⟶ ¬lit_semantics 𝒜 op" }

Hence, the operators are irrelevant for cnf_semantics 𝒜 { C }› where C› is
a clause encoding a positive or negative transition frame axiom for a given variable v› of the
problem. ›
  (* TODO refactor. *)
  {
    let ?add = "{ ((Operator k (index ?ops op))+)
        | op. op  set ?ops  v  set (add_effects_of op) }"
      and ?delete = "{ ((Operator k (index ?ops op))+)
        | op. op  set ?ops  v  set (delete_effects_of op) }"
    {
      fix op
      assume operator_encoding_in_add: "(Operator k (index ?ops op))+  ?add"
      hence "¬lit_semantics 𝒜 ((Operator k (index ?ops op))+)"
        proof (cases "op  set k")
          case True
          then have "v  set (add_effects_of op)"
            using assms(5)
            by simp
          then have "(Operator k (index ?ops op))+  ?add"
            by fastforce
          thus ?thesis
            using operator_encoding_in_add
            by blast
        next
          case False
          then show ?thesis
            proof (cases "op  set ?ops")
              case True
              {
                let ?A = "{ ?ops ! index ?ops op |op.
                   op  set ((Π)𝒪)  𝒜 (Operator k (index ?ops op))}"
                assume "lit_semantics 𝒜 ((Operator k (index ?ops op))+)"
                moreover have operator_active_at_k: "𝒜 (Operator k (index ?ops op))"
                  using calculation
                  by auto
                moreover have "op  set ((Π)𝒪)"
                  using True
                  by force
                moreover have "(?ops ! index ?ops op)  ?A"
                  using calculation(2, 3)
                  by blast
                ultimately have "op  set k"
                  using decode_plan_step_element_then_i[OF assms(3)]
                  by auto
                hence False
                  using False
                  by blast
              }
              thus ?thesis
                by blast
            next
              case False
              then have "op  {op  set ?ops. v  set (add_effects_of op)}"
                by blast
              moreover have "?add =
                (λop. (Operator k (index ?ops op))+)
                  ` { op  set ?ops. v  set (add_effects_of op) }"
                using setcompr_eq_image[of "λop. (Operator k (index ?ops op))+"
                    "λop. op  set ?ops  v  set (add_effects_of op)"]
                by blast
              (* TODO slow. *)
              ultimately have "(Operator k (index ?ops op))+  ?add"
                by force
              thus ?thesis using operator_encoding_in_add
                by blast
            qed
        qed
    } moreover {
      fix op
      assume operator_encoding_in_delete: "((Operator k (index ?ops op))+)  ?delete"
      hence "¬lit_semantics 𝒜 ((Operator k (index ?ops op))+)"
        proof (cases "op  set k")
          case True
          then have "v  set (delete_effects_of op)"
            using assms(5)
            by simp
          then have "(Operator k (index ?ops op))+  ?delete"
            by fastforce
          thus ?thesis
            using operator_encoding_in_delete
            by blast
        next
          case False
          then show ?thesis
            proof (cases "op  set ?ops")
              case True
              {
                let ?A = "{ ?ops ! index ?ops op |op.
                   op  set ((Π)𝒪)  𝒜 (Operator k (index ?ops op))}"
                assume "lit_semantics 𝒜 ((Operator k (index ?ops op))+)"
                moreover have operator_active_at_k: "𝒜 (Operator k (index ?ops op))"
                  using calculation
                  by auto
                moreover have "op  set ((Π)𝒪)"
                  using True
                  by force
                moreover have "(?ops ! index ?ops op)  ?A"
                  using calculation(2, 3)
                  by blast
                ultimately have "op  set k"
                  using decode_plan_step_element_then_i[OF assms(3)]
                  by auto
                hence False
                  using False
                  by blast
              }
              thus ?thesis
                by blast
            next
              case False
              then have "op  { op  set ?ops. v  set (delete_effects_of op) }"
                by blast
              moreover have "?delete =
                (λop. (Operator k (index ?ops op))+)
                  ` { op  set ?ops. v  set (delete_effects_of op) }"
                using setcompr_eq_image[of "λop. (Operator k (index ?ops op))+"
                    "λop. op  set ?ops  v  set (delete_effects_of op)"]
                by blast
              (* TODO slow. *)
              ultimately have "(Operator k (index ?ops op))+  ?delete"
                by force
              thus ?thesis using operator_encoding_in_delete
                by blast
            qed
        qed
    }
    ultimately have "op. op  ?add  ¬lit_semantics 𝒜 op"
    and "op. op  ?delete  ¬lit_semantics 𝒜 op"
      by blast+
  } note nb = this
  {
    let ?Ops = "{ (Operator k (index ?ops op))+
      | op. op  set ?ops  v  set (add_effects_of op) }"
    have "?Ops  ?C"
      by blast
    moreover have "?C - ?Ops = { (State k (index ?vs v))+ , (State (Suc k) (index ?vs v))¯  }"
      by fast
    moreover have "L  ?Ops. ¬ lit_semantics 𝒜 L"
      using nb(1)
      by blast
    (* TODO slow. *)
    ultimately have "clause_semantics 𝒜 ?C
      = clause_semantics 𝒜 { (State k (index ?vs v))+, (State (Suc k) (index ?vs v))¯ }"
      using lit_semantics_reducible_to_subset_if[of ?Ops ?C]
      by presburger
  }  moreover {
    let ?Ops' = "{ (Operator k (index ?ops op))+
      | op. op  set ?ops  v  set (delete_effects_of op) }"
    have "?Ops'  ?C'"
      by blast
    moreover have "?C' - ?Ops' = { (State k (index ?vs v))¯ , (State (Suc k) (index ?vs v))+ }"
      by fast
    moreover have "L  ?Ops'. ¬ lit_semantics 𝒜 L"
      using nb(2)
      by blast
    (* TODO slow. *)
    ultimately have "clause_semantics 𝒜 ?C'
      = clause_semantics 𝒜 { (State k (index ?vs v))¯, (State (Suc k) (index ?vs v))+ }"
      using lit_semantics_reducible_to_subset_if[of ?Ops' ?C']
      by presburger
  }  moreover {
    have cnf_semantics_𝒜_Φ:"cnf_semantics 𝒜 (cnf )"
      using valuation_models_encoding_cnf_formula_equals[OF assms(1)] assms(2)
      by blast
    have k_v_included: "(k, v)  ({..<t} × set ((Π)𝒱))"
      using assms(3, 4)
      by blast
    (* TODO slow. *)
    have c_in_un_a: "?C  ?A" and c'_in_un_b: "?C'  ?B"
      using k_v_included
      by force+
    (* TODO slow. *)
    then have "?C  cnf F" and "?C'  cnf F"
      subgoal
        using cnf_of_encode_all_frame_axioms_structure UnI1[of "?C" "?A" "?B"] c_in_un_a
        by metis
      subgoal
        using cnf_of_encode_all_frame_axioms_structure UnI2[of "?C'" "?B" "?A"] c'_in_un_b
        by metis
      done
    then have "{ ?C }  cnf F" and c'_subset_frame_axiom_encoding: "{ ?C' }  cnf F"
      by blast+
    then have "{ ?C }  cnf " and "{ ?C' }  cnf "
      subgoal
        using operator_encoding_subset_encoding
        by fast
      subgoal
        using c'_subset_frame_axiom_encoding operator_encoding_subset_encoding
        by fast
      done
    (* TODO slow. *)
    hence "cnf_semantics 𝒜 { ?C }" and "cnf_semantics 𝒜 { ?C' }"
      using cnf_semantics_𝒜_Φ model_for_cnf_is_model_of_all_subsets
      by fastforce+
  }
  ultimately show "cnf_semantics 𝒜 {{ (State k (index ?vs v))¯, (State (Suc k) (index ?vs v))+ }}"
    and "cnf_semantics 𝒜 {{ (State k (index ?vs v))+, (State (Suc k) (index ?vs v))¯ }}"
    unfolding cnf_semantics_def
    by blast+
qed

lemma encode_problem_parallel_correct_v:
  assumes "is_valid_problem_strips Π"
    and "𝒜  Φ Π t"
    and "k < length (Φ¯ Π 𝒜 t)"
  shows "(ΦS¯ Π 𝒜 (Suc k)) = execute_parallel_operator (ΦS¯ Π 𝒜 k) ((Φ¯ Π 𝒜 t) ! k)"
proof -
  let ?vs = "strips_problem.variables_of Π"
    and ?ops = "strips_problem.operators_of Π"
    and  = "Φ¯ Π 𝒜 t"
    and ?sk = "ΦS¯ Π 𝒜 k"
    and ?sk' = "ΦS¯ Π 𝒜 (Suc k)"
  let ?tk' = "execute_parallel_operator ?sk ( ! k)"
    and k = " ! k"
  have k_lt_t: "k < t" and k_lte_t: "k  t" and suc_k_lte_t: "Suc k  t"
    using decode_plan_length[of  Π 𝒜 t] assms(3)
    by (argo, fastforce+)
  then have operator_preconditions_hold:
    "are_all_operators_applicable ?sk k  are_all_operator_effects_consistent k"
    using encode_problem_parallel_correct_ii[OF assms(1, 2, 3)]
    by blast
  ― ‹ We show the goal in classical fashion by proving that
      @{text[display, indent=4] S¯ Π 𝒜 (Suc k) v
        = execute_parallel_operator (ΦS¯ Π 𝒜 k)
          ((Φ¯ Π 𝒜 t) ! k) v"}
    ---i.e. the state decoded at time k + 1› is equivalent to the state obtained by executing the
    parallel operator (Φ¯ Π 𝒜 t) ! k› on the previous state
    ΦS¯ Π 𝒜 k›—for all variables v› given k < t›, a model 𝒜›,
    and makespan t›. ›
  moreover {
    {
      fix v
      assume v_in_dom_sk':"v  dom ?sk'"
      then have sk'_not_none: "?sk' v  None"
        by blast
      hence "?sk' v = ?tk' v"
        proof (cases "op  set k. v  set (add_effects_of op)  v  set (delete_effects_of op)")
          case True
          then obtain op
            where op_in_πk: "op  set k"
            and "v  set (add_effects_of op)  v  set (delete_effects_of op)"
            by blast
          then consider (v_is_add_effect) "v  set (add_effects_of op)"
            | (v_is_delete_effect) "v  set (delete_effects_of op)"
            by blast
          then show ?thesis
            proof (cases)
              case v_is_add_effect
              then have "?sk' v = Some True"
                using encode_problem_parallel_correct_iii(1)[OF assms(1, 2, 3) op_in_πk]
                  v_is_add_effect
                by blast
              moreover have "are_all_operators_applicable (ΦS¯ Π 𝒜 k) ((Φ¯ Π 𝒜 t) ! k)"
                and "are_all_operator_effects_consistent ((Φ¯ Π 𝒜 t) ! k)"
                using operator_preconditions_hold v_is_add_effect
                by blast+
              moreover have "?tk' v = Some True"
                using execute_parallel_operator_positive_effect_if[of
                    "ΦS¯ Π 𝒜 k" "(Φ¯ Π 𝒜 t) ! k"] op_in_πk
                  v_is_add_effect calculation(2, 3)
                by blast
              ultimately show ?thesis
                by argo
            next
              case v_is_delete_effect
              then have "?sk' v = Some False"
                using encode_problem_parallel_correct_iii(2)[OF assms(1, 2, 3) op_in_πk]
                  v_is_delete_effect
                by blast
              moreover have "are_all_operators_applicable (ΦS¯ Π 𝒜 k) ((Φ¯ Π 𝒜 t) ! k)"
                and "are_all_operator_effects_consistent ((Φ¯ Π 𝒜 t) ! k)"
                using operator_preconditions_hold
                by blast+
              moreover have "?tk' v = Some False"
                using execute_parallel_operator_effect(2) op_in_πk
                  v_is_delete_effect calculation(2, 3)
                by fast
              moreover have "?tk' v = Some False"
                by (meson execute_parallel_operator_negative_effect_if op_in_πk operator_preconditions_hold v_is_delete_effect)
              ultimately show ?thesis
                by argo
            qed
        next
          case False
          (* TODO slow. *)
          then have "?tk' v = ?sk v"
            using execute_parallel_operator_no_effect_if
            by fastforce
          moreover {
            have v_in_set_vs: "v  set ((Π)𝒱)"
              using decode_state_at_valid_variable[OF sk'_not_none].
            then have state_propagation_positive:
              "cnf_semantics 𝒜 {{(State k (index ?vs v))¯
                , (State (Suc k) (index ?vs v))+}}"
            and state_propagation_negative:
              "cnf_semantics 𝒜 {{(State k (index ?vs v))+
                , (State (Suc k) (index ?vs v))¯}}"
              using encode_problem_parallel_correct_iv[OF assms(1, 2) k_lt_t _ False]
              by fastforce+
            consider (sk'_v_positive) "?sk' v = Some True"
              | (sk'_v_negative) "?sk' v = Some False"
              using sk'_not_none
              by fastforce
            hence "?sk' v = ?sk v"
              proof (cases)
                case sk'_v_positive
                then have "lit_semantics 𝒜 ((State (Suc k) (index ?vs v))+)"
                  using decode_state_at_encoding_variables_equals_some_of_valuation_if[OF
                      assms(1, 2) suc_k_lte_t v_in_set_vs]
                  by fastforce
                (* TODO slow. *)
                then have "lit_semantics 𝒜 ((State k (index ?vs v))+)"
                  using state_propagation_negative
                  unfolding cnf_semantics_def clause_semantics_def
                  by fastforce
                then show ?thesis
                  using decode_state_at_encoding_variables_equals_some_of_valuation_if[OF
                      assms(1, 2) k_lte_t v_in_set_vs] sk'_v_positive
                  by fastforce
              next
                case sk'_v_negative
                then have "¬lit_semantics 𝒜 ((State (Suc k) (index ?vs v))+)"
                  using decode_state_at_encoding_variables_equals_some_of_valuation_if[
                      OF assms(1, 2) suc_k_lte_t v_in_set_vs]
                  by fastforce
                (* TODO slow. *)
                then have "¬lit_semantics 𝒜 ((State k (index ?vs v))+)"
                  using state_propagation_positive
                  unfolding cnf_semantics_def clause_semantics_def
                  by fastforce
                then show ?thesis
                  using decode_state_at_encoding_variables_equals_some_of_valuation_if[OF
                      assms(1, 2) k_lte_t v_in_set_vs] sk'_v_negative
                  by fastforce
              qed
          }
          ultimately show ?thesis
            by argo
        qed
      }
    hence "?sk' m ?tk'"
      using map_le_def
      by blast
  }
  moreover {
    {
      fix v
      assume "v  dom ?tk'"
      then have tk'_not_none: "?tk' v  None"
        by blast
      {
        {
          assume contradiction: "v  set ((Π)𝒱)"
          then have "(ΦS¯ Π 𝒜 k) v = None"
            using decode_state_at_valid_variable
            by fastforce
          then obtain op
            where op_in: "op  set ((Φ¯ Π 𝒜 t) ! k)"
              and v_is_or: "v  set (add_effects_of op)
                 v  set (delete_effects_of op)"
            using execute_parallel_operators_strips_none_if_contraposition[OF
                tk'_not_none]
            by blast
          have op_in: "op  set ((Π)𝒪)"
              using op_in decode_plan_step_element_then(1) k_lt_t
              by blast
          consider (A) "v  set (add_effects_of op)"
            | (B) "v  set (delete_effects_of op)"
            using v_is_or
            by blast
          hence False
            proof (cases)
              case A
              then have "v  set ((Π)𝒱)"
                using is_valid_problem_strips_operator_variable_sets(2)[OF
                    assms(1)] op_in A
                by blast
              thus False
                using contradiction
                by blast
            next
              case B
              then have "v  set ((Π)𝒱)"
                using is_valid_problem_strips_operator_variable_sets(3)[OF
                    assms(1)] op_in B
                by blast
              thus False
                using contradiction
                by blast
            qed
          }
      }
      hence v_in_set_vs: "v  set ((Π)𝒱)"
        by blast
      hence "?tk' v = ?sk' v"
        proof (cases "(opset k. v  set (add_effects_of op)  v  set (delete_effects_of op))")
          case True
          then obtain op
            where op_in_set_πk: "op  set k"
            and v_options: "v  set (add_effects_of op)  v  set (delete_effects_of op)"
            by blast
          then have "op  set ((Π)𝒪)"
            using decode_plan_step_element_then[OF k_lt_t]
            by blast
          then consider (v_is_add_effect) "v  set (add_effects_of op)"
            | (v_is_delete_effect) "v  set (delete_effects_of op)"
            using v_options
            by blast
          thus ?thesis
            proof (cases)
              case v_is_add_effect
              then have "?tk' v = Some True"
                using execute_parallel_operator_positive_effect_if[OF _ _ op_in_set_πk]
                  operator_preconditions_hold
                by blast
              moreover have "?sk' v = Some True"
                using encode_problem_parallel_correct_iii(1)[OF assms(1, 2, 3) op_in_set_πk]
                  v_is_add_effect
                by blast
              ultimately show ?thesis
                by argo
            next
              case v_is_delete_effect
              then have "?tk' v = Some False"
                using execute_parallel_operator_negative_effect_if[OF _ _ op_in_set_πk]
                  operator_preconditions_hold
                by blast
              moreover have "?sk' v = Some False"
                using encode_problem_parallel_correct_iii(2)[OF assms(1, 2, 3) op_in_set_πk]
                  v_is_delete_effect
                by blast
              ultimately show ?thesis
                by argo
            qed
        next
          case False
          have state_propagation_positive:
            "cnf_semantics 𝒜 {{(State k (index ?vs v))¯, (State (Suc k) (index ?vs v))+}}"
          and state_propagation_negative:
            "cnf_semantics 𝒜 {{(State k (index ?vs v))+, (State (Suc k) (index ?vs v))¯}}"
            using encode_problem_parallel_correct_iv[OF assms(1, 2) k_lt_t v_in_set_vs
                False]
            by blast+
          {
            have all_op_in_set_πk_have_no_effect:
              "op  set k. v  set (add_effects_of op)  v  set (delete_effects_of op)"
              using False
              by blast
            then have "?tk' v = ?sk v"
              using execute_parallel_operator_no_effect_if[OF all_op_in_set_πk_have_no_effect]
              by blast
          } note tk'_equals_sk = this
          {
            have "?sk v  None"
              using tk'_not_none tk'_equals_sk
              by argo
            then consider (sk_v_is_some_true) "?sk v = Some True"
              | (sk_v_is_some_false) "?sk v = Some False"
              by fastforce
          }
          then show ?thesis
            proof (cases)
              case sk_v_is_some_true
              moreover {
                have "lit_semantics 𝒜 ((State k (index ?vs v))+)"
                  using decode_state_at_encoding_variables_equals_some_of_valuation_if[OF
                      assms(1, 2) k_lte_t v_in_set_vs] sk_v_is_some_true
                  by simp
                then have "lit_semantics 𝒜 ((State (Suc k) (index ?vs v))+)"
                  using state_propagation_positive
                  unfolding cnf_semantics_def clause_semantics_def
                  by fastforce
                then have "?sk' v = Some True"
                  using decode_state_at_encoding_variables_equals_some_of_valuation_if[OF
                      assms(1, 2) suc_k_lte_t v_in_set_vs]
                  by fastforce
              }
              ultimately show ?thesis
                using tk'_equals_sk
                by simp
            next
              case sk_v_is_some_false
              moreover {
                have "lit_semantics 𝒜 ((State k (index ?vs v))¯)"
                  using decode_state_at_encoding_variables_equals_some_of_valuation_if[OF
                      assms(1, 2) k_lte_t v_in_set_vs] sk_v_is_some_false
                  by simp
                then have "lit_semantics 𝒜 ((State (Suc k) (index ?vs v))¯)"
                  using state_propagation_negative
                  unfolding cnf_semantics_def clause_semantics_def
                  by fastforce
                then have "?sk' v = Some False"
                  using decode_state_at_encoding_variables_equals_some_of_valuation_if[OF
                      assms(1, 2) suc_k_lte_t v_in_set_vs]
                  by fastforce
              }
              ultimately show ?thesis
                using tk'_equals_sk
                by simp
            qed
        qed
    }
    hence "?tk' m ?sk'"
    using map_le_def
    by blast
  }
  ultimately show ?thesis
    using map_le_antisym
    by blast
qed

lemma encode_problem_parallel_correct_vi:
  assumes "is_valid_problem_strips Π"
    and "𝒜  Φ Π t"
    and "k < length (trace_parallel_plan_strips ((Π)I) (Φ¯ Π 𝒜 t))"
  shows "trace_parallel_plan_strips ((Π)I) (Φ¯ Π 𝒜 t) ! k
    = ΦS¯ Π 𝒜 k"
  using assms
proof -
  let ?I = "(Π)I"
    and  = "Φ¯ Π 𝒜 t"
  let  = "trace_parallel_plan_strips ?I "
  show ?thesis
    using assms
    proof (induction k)
      case 0
      hence " ! 0 = ?I"
        using trace_parallel_plan_strips_head_is_initial_state
        by blast
      moreover have "ΦS¯ Π 𝒜 0 = ?I"
        using decode_state_at_initial_state[OF assms(1, 2)]
        by simp
      ultimately show ?case
        by simp
    next
      case (Suc k)
      let k = "trace_parallel_plan_strips ?I  ! k"
        and ?sk = "ΦS¯ Π 𝒜 k"
      have k_lt_length_τ_minus_one: "k < length  - 1" and k_lt_length_τ: "k < length "
        using Suc.prems(3)
        by linarith+
      ― ‹ Use the induction hypothesis to obtain the proposition for the previous step $k$.
        Then, show that applying the $k$-th parallel operator in the plan $\pi$ on either the state
        obtained from the trace or decoded from the model yields the same successor state. ›
      {
        have " ! k = execute_parallel_plan ?I (take k )"
          using trace_parallel_plan_plan_prefix k_lt_length_τ
          by blast
        hence "k = ?sk"
          using Suc.IH[OF assms(1, 2) k_lt_length_τ]
          by blast
      }
      moreover have "trace_parallel_plan_strips ?I  ! Suc k
        = execute_parallel_operator k ( ! k)"
        using trace_parallel_plan_step_effect_is[OF k_lt_length_τ_minus_one]
        by blast
      moreover {
        thm Suc.prems(3)
        have "length (trace_parallel_plan_strips ?I )  length  + 1"
          using length_trace_parallel_plan_strips_lte_length_plan_plus_one
          by blast
        then have "k < length "
          using Suc.prems(3)
          unfolding Suc_eq_plus1
          by linarith
        hence "ΦS¯ Π 𝒜 (Suc k)
          = execute_parallel_operator ?sk ( ! k)"
          using encode_problem_parallel_correct_v[OF assms(1, 2)]
          by simp
      }
      ultimately show ?case
        by argo
    qed
qed

lemma encode_problem_parallel_correct_vii:
  assumes "is_valid_problem_strips Π"
    and "𝒜  Φ Π t"
  shows "length (map (decode_state_at Π 𝒜)
      [0..<Suc (length (Φ¯ Π 𝒜 t))])
    = length (trace_parallel_plan_strips ((Π)I) (Φ¯ Π 𝒜 t))"
proof -
  let ?I = "(Π)I"
    and  = "Φ¯ Π 𝒜 t"
  let  = "map (decode_state_at Π 𝒜) [0..<Suc (length )]"
    and  = "trace_parallel_plan_strips ?I "
  let ?l = "length  "
  let ?k = "?l - 1"
  show ?thesis
    proof (rule ccontr)
      assume length_σ_neq_length_τ: "length   length "
      {
        have "length  = length  + 1"
          by fastforce
        moreover have "length   length  + 1"
          using length_trace_parallel_plan_strips_lte_length_plan_plus_one
          by blast
        moreover have "length  < length  + 1"
          using length_σ_neq_length_τ calculation
          by linarith
      } note nb1 = this
      {
        have "0 < length "
          using trace_parallel_plan_strips_not_nil..
        then have "length  - 1 < length "
          using nb1
          by linarith
      } note nb2 = this
      {
        obtain k' where "length  = Suc k'"
          using less_imp_Suc_add[OF length_trace_parallel_plan_gt_0]
          by blast
        hence "?k < length "
          using nb2
          by blast
      } note nb3 = this
      {
        have " ! ?k = execute_parallel_plan ?I (take ?k )"
          using trace_parallel_plan_plan_prefix[of ?k]
            length_trace_minus_one_lt_length_trace
          by blast
        thm encode_problem_parallel_correct_vi[OF assms(1, 2)] nb3
        moreover have "(ΦS¯ Π 𝒜 ?k) =  ! ?k"
          using encode_problem_parallel_correct_vi[OF assms(1, 2)
              length_trace_minus_one_lt_length_trace]..
        ultimately have "(ΦS¯ Π 𝒜 ?k)  = execute_parallel_plan ?I (take ?k )"
          by argo
      } note nb4 = this
      {
        have "are_all_operators_applicable (ΦS¯ Π 𝒜 ?k) ( ! ?k)"
          and "are_all_operator_effects_consistent ( ! ?k)"
          using encode_problem_parallel_correct_ii(1, 2)[OF assms(1, 2)] nb3
          by blast+
        ― ‹ Unsure why calculation(1, 2)› is needed for this proof step. Should just require the
          default proof. ›
        moreover have "¬are_all_operators_applicable (ΦS¯ Π 𝒜 ?k) ( ! ?k)"
          and "¬are_all_operator_effects_consistent ( ! ?k)"
          using length_trace_parallel_plan_strips_lt_length_plan_plus_one_then[OF nb1]
            calculation(1, 2)
          unfolding nb3 nb4
          by blast+
        ultimately have False
          by blast
      }
      thus False.
    qed
qed

lemma encode_problem_parallel_correct_x:
  assumes "is_valid_problem_strips Π"
    and "𝒜  Φ Π t"
  shows "map (decode_state_at Π 𝒜)
      [0..<Suc (length (Φ¯ Π 𝒜 t))]
    = trace_parallel_plan_strips ((Π)I) (Φ¯ Π 𝒜 t)"
proof -
  let ?I = "(Π)I"
    and  = "Φ¯ Π 𝒜 t"
  let  = "map (decode_state_at Π 𝒜) [0..<Suc (length )]"
    and  = "trace_parallel_plan_strips ?I "
  {
    have "length  = length "
      using encode_problem_parallel_correct_vii[OF assms]..
    moreover {
      fix k
      assume k_lt_length_τ: "k < length "
      then have "trace_parallel_plan_strips ((Π)I) (Φ¯ Π 𝒜 t) ! k
        = ΦS¯ Π 𝒜 k"
        using encode_problem_parallel_correct_vi[OF assms]
        by blast
      moreover {
        have "length   length  + 1"
          using length_trace_parallel_plan_strips_lte_length_plan_plus_one
          by blast
        then have "k < length  + 1"
          using k_lt_length_τ
          by linarith
        then have "k < Suc (length ) - 0"
          by simp
        hence " ! k = ΦS¯ Π 𝒜 k"
          using nth_map_upt[of k "Suc (length )" 0]
          by auto
      }
      ultimately have " ! k =  ! k"
        by argo
    }
    ultimately have " = "
      using list_eq_iff_nth_eq[of  ]
      by blast
  }
  thus ?thesis
    by argo
qed

lemma encode_problem_parallel_correct_xi:
  fixes Π:: "'a strips_problem"
  assumes "is_valid_problem_strips Π"
   and "𝒜  Φ Π t"
   and "ops  set (Φ¯ Π 𝒜 t)"
   and "op  set ops"
 shows "op  set ((Π)𝒪)"
proof -
  let  = "Φ¯ Π 𝒜 t"
  have "length  = t"
    using decode_plan_length
    by force
  moreover obtain k where "k < length " and "ops =  ! k"
    using in_set_conv_nth[of ops ] assms(3)
    unfolding calculation
    by blast
  ultimately show ?thesis
    using assms(4) decode_plan_step_element_then(1)
    by force
qed


text ‹ To show soundness, we have to prove the following: given the existence of a model
term𝒜 of the basic SATPlan encoding term‹encode_problem Π t for a given valid problem termΠ
and hypothesized plan length termt, the decoded plan termπ  Φ¯ Π 𝒜 t is a parallel solution
for termΠ.

We show this theorem by showing equivalence between the execution trace of the decoded plan and the
sequence of states

  @{text[display, indent=4] "σ = map (λ k. ΦS¯ Π 𝒜 k) [0..<Suc (length ?π)]" }

decoded from the model term𝒜. Let

  @{text[display, indent=4] "τ ≡ trace_parallel_plan_strips I π"}

be the trace of termπ. Theorem \ref{isathm:soundness-satplan-encoding} first establishes the
equality termσ = τ of the decoded state sequence and the trace of termπ.
We can then derive that termG m last σ by lemma \ref{isathm:parallel-solution-trace-strips}, i.e. the last
state reached by plan execution (and moreover the last state decoded from the model), satisfies the
goal state termG defined by the problem. By lemma \ref{isathm:parallel-solution-trace-strips}, we
can conclude that termπ is a solution for termI and termG.

Moreover, we show that all operators termop in all parallel operators termops  set π
are also contained in term𝒪. This is the case because the plan decoding function reverses the
encoding function (which only encodes operators in term𝒪).

By definition \ref{isadef:parallel-solution-strips} this means that termπ is a parallel solution
for termΠ. Moreover termπ has length termt as confirmed by lemma
\isaname{decode_plan_length}.
\footnote{This lemma is used in the proof but not shown.} ›

theorem  encode_problem_parallel_sound:
  assumes "is_valid_problem_strips Π"
    and "𝒜  Φ Π t"
  shows "is_parallel_solution_for_problem Π (Φ¯ Π 𝒜 t)"
  proof -
    let ?ops = "strips_problem.operators_of Π"
      and ?I = "(Π)I"
      and ?G = "(Π)G"
      and  = "Φ¯ Π 𝒜 t"
    let  = "map (λ k. ΦS¯ Π 𝒜 k) [0..<Suc (length )]"
      and  = "trace_parallel_plan_strips ?I "
    {
      have " = "
        using encode_problem_parallel_correct_x[OF assms].
      moreover {
        have "length  = t"
          using decode_plan_length
          by auto
        then have "?G m last "
          using decode_state_at_goal_state[OF assms]
          by simp
      }
      ultimately have "((Π)G) m execute_parallel_plan ((Π)I) (Φ¯ Π 𝒜 t)"
        using execute_parallel_plan_reaches_goal_iff_goal_is_last_element_of_trace
        by auto
    }
    moreover have "ops  set . op  set ops. op  set ((Π)𝒪)"
      using encode_problem_parallel_correct_xi[OF assms(1, 2)]
      by auto
    ultimately show ?thesis
      unfolding is_parallel_solution_for_problem_def
      unfolding list_all_iff ListMem_iff operators_of_def STRIPS_Representation.operators_of_def
      by fastforce
  qed

value  "stop" (* Tell document preparation to stop collecting for the last tag *)



subsection "Completeness"

(* TODO make abbreviation *)
definition empty_valuation :: "sat_plan_variable valuation" ("𝒜0")
  where "empty_valuation   (λ_. False)"

abbreviation valuation_for_state
  :: "'variable list
    'variable strips_state
     nat
     'variable
     sat_plan_variable valuation
     sat_plan_variable valuation"
  where "valuation_for_state vs s k v 𝒜
     𝒜(State k (index vs v) := (s v = Some True))"

― ‹ Since the trace may be shorter than the plan length even though the last trace element
subsumes the goal state---namely in case plan execution is impossible due to violation of the
execution condition but the reached state serendipitously subsumes the goal state---, we also have
to repeat the valuation for all time steps termk'  {length τ..(length π + 1)} for all \
termv  𝒱 (see term𝒜2). ›
definition valuation_for_state_variables
  :: "'variable strips_problem
     'variable strips_operator list list
     'variable strips_state list
     sat_plan_variable valuation"
  where "valuation_for_state_variables Π π τ  let
      t' = length τ
      ; τΩ = τ ! (t' - 1)
      ; vs = variables_of Π
      ; V1 = { State k (index vs v) | k v. k  {0..<t'}  v  set vs }
      ; V2 = { State k (index vs v) | k v. k  {t'..(length π + 1)}  v  set vs }
      ; 𝒜1 = foldr
        (λ(k, v) 𝒜. valuation_for_state (variables_of Π) (τ ! k) k v 𝒜)
        (List.product [0..<t'] vs)
        𝒜0
      ; 𝒜2 = foldr
        (λ(k, v) 𝒜. valuation_for_state (variables_of Π) τΩ k v 𝒜)
        (List.product [t'..<length π + 2] vs)
        𝒜0
    in override_on (override_on 𝒜0 𝒜1 V1) 𝒜2 V2"

― ‹ The valuation is left to yield false for the potentially remaining
termk'  {length τ..(length π + 1)} since no more operators are executed after the trace ends
anyway. The definition of term𝒜0 as the valuation that is false for every argument ensures
this implicitely. ›
definition valuation_for_operator_variables
  :: "'variable strips_problem
     'variable strips_operator list list
     'variable strips_state list
     sat_plan_variable valuation"
  where "valuation_for_operator_variables Π π τ  let
      ops = operators_of Π
      ; Op = { Operator k (index ops op) | k op. k  {0..<length τ - 1}  op  set ops }
    in override_on
      𝒜0
      (foldr
        (λ(k, op) 𝒜. 𝒜(Operator k (index ops op) := True))
        (concat (map (λk. map (Pair k) (π ! k)) [0..<length τ - 1]))
        𝒜0)
      Op"


text ‹ The completeness proof requires that we show that the SATPlan encoding termΦ Π t of a
problem termΠ has a model term𝒜 in case a solution termπ with length termt exists.
Since a plan corresponds to a state trace termτ  trace_parallel_plan_strips I π with
  @{text[display, indent=4] "τ ! k = execute_parallel_plan I (take k π)"}
for all termk < length τ we can construct a valuation term𝒜V modeling the state sequence in
termτ by letting
  @{text[display, indent=4] "𝒜(State k (index vs v) := (s v = Some True))"}
or all termv  𝒱 where terms  τ ! k .
\footnote{It is helpful to remember at this point, that the trace elements of a solution contain
the states reached by plan prefix execution (lemma \ref{isathm:trace-elements-and-plan-prefixes}).}

Similarly to term𝒜V, we obtain an operator valuation term𝒜O by defining
  @{text[display, indent=4] "𝒜(Operator k (index ops op) := True)"}
for all operators termop  𝒪 s.t. termop  set (π ! k) for all termk < length τ - 1.

The overall valuation for the plan execution term𝒜 can now be constructed by combining the
state variable valuation term𝒜V and operator valuation term𝒜O. ›

definition  valuation_for_plan
  :: "'variable strips_problem
     'variable strips_operator list list
     sat_plan_variable valuation"
  where "valuation_for_plan Π π  let
      vs = variables_of Π
      ; ops = operators_of Π
      ; τ = trace_parallel_plan_strips (initial_of Π) π
      ; t = length π
      ; t' = length τ
      ; 𝒜V = valuation_for_state_variables Π π τ
      ; 𝒜O = valuation_for_operator_variables Π π τ
      ; V = { State k (index vs v)
        | k v. k  {0..<t + 1}  v  set vs }
      ; Op = { Operator k (index ops op)
        | k op. k  {0..<t}  op  set ops }
    in override_on (override_on 𝒜0 𝒜V V) 𝒜O Op"


― ‹ Show that in case of an encoding with makespan zero, it suffices to show that a given
model satisfies the initial state and goal state encodings. ›
(* TODO refactor. *)
lemma model_of_encode_problem_makespan_zero_iff:
  "𝒜  Φ Π 0  𝒜  ΦI Π  (ΦG Π) 0"
proof -
  have "encode_operators Π 0 = ¬  ¬"
    unfolding encode_operators_def encode_all_operator_effects_def
      encode_all_operator_preconditions_def
    by simp
  moreover have "encode_all_frame_axioms Π 0 = ¬"
    unfolding encode_all_frame_axioms_def
    by simp
  ultimately show ?thesis
    unfolding encode_problem_def SAT_Plan_Base.encode_problem_def encode_initial_state_def
      encode_goal_state_def
    by simp
qed

(* TODO refactor. *)
lemma empty_valution_is_False[simp]: "𝒜0 v = False"
  unfolding empty_valuation_def..

lemma  model_initial_state_set_valuations:
  assumes "is_valid_problem_strips Π"
  shows "set (map (λv. case ((Π)I) v of Some b
           𝒜0(State 0 (index (strips_problem.variables_of Π) v) := b)
        | _  𝒜0)
      (strips_problem.variables_of Π))
    = { 𝒜0(State 0 (index (strips_problem.variables_of Π) v) := the (((Π)I) v))
      | v. v  set ((Π)𝒱) }"
proof -
  let ?I = "(Π)I"
    and ?vs = "strips_problem.variables_of Π"
  let ?f = "λv. case ((Π)I) v of Some b
     𝒜0(State 0 (index ?vs v) := b) | _  𝒜0"
    and ?g = "λv. 𝒜0(State 0 (index ?vs v) := the (?I v))"
  let ?𝒜s = "map ?f ?vs"
  have nb1: "dom ?I = set ((Π)𝒱)"
    using is_valid_problem_strips_initial_of_dom assms
    by fastforce
  {
    {
      fix v
      assume "v  dom ?I"
      hence "?f v = ?g v"
        using nb1
        by fastforce
    }
    hence "?f ` set ((Π)𝒱) = ?g ` set ((Π)𝒱)"
      using nb1
      by force
  }
  then have "set ?𝒜s = ?g ` set ((Π)𝒱)"
    unfolding set_map
    by simp
  thus ?thesis
    by blast
qed

(* TODO refactor *)
lemma valuation_of_state_variable_implies_lit_semantics_if:
  assumes "v  dom S"
    and "𝒜 (State k (index vs v)) = the (S v)"
  shows "lit_semantics 𝒜 (literal_formula_to_literal (encode_state_variable k (index vs v) (S v)))"
proof -
  let ?L = "literal_formula_to_literal (encode_state_variable k (index vs v) (S v))"
  consider (True) "S v = Some True"
    | (False) "S v = Some False"
    using assms(1)
    by fastforce
  thus ?thesis
    unfolding encode_state_variable_def
    using assms(2)
    by (cases, force+)
qed

(* TODO refactor ‹Fun_Supplement›? *)
lemma foldr_fun_upd:
  assumes "inj_on f (set xs)"
    and "x  set xs"
  shows "foldr (λx 𝒜. 𝒜(f x := g x)) xs 𝒜 (f x) = g x"
  using assms
proof (induction xs)
  case (Cons a xs)
  then show ?case
    proof (cases "xs = []")
      case True
      then have "x = a"
        using Cons.prems(2)
        by simp
      thus ?thesis
        by simp
    next
      case False
      thus ?thesis
        proof (cases "a = x")
        next
          case False
          {
            from False
            have "x  set xs"
              using Cons.prems(2)
              by simp
            moreover have "inj_on f (set xs)"
              using Cons.prems(1)
              by fastforce
            ultimately have "(foldr (λx 𝒜. 𝒜(f x := g x)) xs 𝒜) (f x) = g x"
              using Cons.IH
              by blast
          } moreover {
            ― ‹ Follows from modus tollens on the definition of @{text "inj_on"}. ›
            have "f a  f x"
              using Cons.prems False
              by force
            moreover have "foldr (λx 𝒜. 𝒜(f x := g x)) (a # xs) 𝒜
              = (foldr (λx 𝒜. 𝒜(f x := g x)) xs 𝒜)(f a := g a)"
              by simp
            ultimately have "foldr (λx 𝒜. 𝒜(f x := g x)) (a # xs) 𝒜 (f x)
              = (foldr (λx 𝒜. 𝒜(f x := g x)) xs 𝒜) (f x)"
              unfolding fun_upd_def
              by presburger
          } ultimately show ?thesis
            by argo
       qed simp
   qed
qed fastforce

lemma foldr_fun_no_upd:
  assumes "inj_on f (set xs)"
    and "y  f ` set xs"
  shows "foldr (λx 𝒜. 𝒜(f x := g x)) xs 𝒜 y = 𝒜 y"
  using assms
proof (induction xs)
  case (Cons a xs)
  {
    have "inj_on f (set xs)" and "y  f ` set xs"
      using Cons.prems
      by (fastforce, simp)
    hence "foldr (λx 𝒜. 𝒜(f x := g x)) xs 𝒜 y = 𝒜 y"
      using Cons.IH
      by blast
  }
  moreover {
    have "f a  y"
      using Cons.prems(2)
      by auto
    moreover have "foldr (λx 𝒜. 𝒜(f x := g x)) (a # xs) 𝒜
      = (foldr (λx 𝒜. 𝒜(f x := g x)) xs 𝒜)(f a := g a)"
      by simp
    ultimately have "foldr (λx 𝒜. 𝒜(f x := g x)) (a # xs) 𝒜 y
      = (foldr (λx 𝒜. 𝒜(f x := g x)) xs 𝒜) y"
      unfolding fun_upd_def
      by presburger
  }
  ultimately show ?case
    by argo
qed simp

― ‹ We only use the part of the characterization of 𝒜› which pertains to the state
variables here. ›
lemma encode_problem_parallel_complete_i:
  fixes Π::"'a strips_problem"
  assumes "is_valid_problem_strips Π"
    and "(Π)G m execute_parallel_plan ((Π)I) π"
     "v k. k < length (trace_parallel_plan_strips ((Π)I) π)
        (𝒜 (State k (index (strips_problem.variables_of Π) v))
           (trace_parallel_plan_strips ((Π)I) π ! k) v = Some True)
         (¬𝒜 (State k (index (strips_problem.variables_of Π) v))
           ((trace_parallel_plan_strips ((Π)I) π ! k) v  Some True))"
  shows "𝒜  ΦI Π"
proof -
  let ?vs = "strips_problem.variables_of Π"
    and ?I = "(Π)I"
    and ?G = "(Π)G"
    and I = "ΦI Π"
  let  = "trace_parallel_plan_strips ?I π"
  {
    fix C
    assume "C  cnf I"
    then obtain v
      where v_in_set_vs: "v  set ?vs"
      and C_is: "C = { literal_formula_to_literal (encode_state_variable 0 (index ?vs v) (?I v)) }"
      using cnf_of_encode_initial_state_set_ii[OF assms(1)]
      by auto
    {
      have "0 < length "
        using trace_parallel_plan_strips_not_nil
        by blast
      then have "𝒜 (State 0 (index (strips_problem.variables_of Π) v))
           (trace_parallel_plan_strips ((Π)I) π ! 0) v = Some True"
        and "¬𝒜 (State 0 (index (strips_problem.variables_of Π) v))
           ((trace_parallel_plan_strips ((Π)I) π ! 0) v  Some True)"
        using assms(3)
        by (presburger+)
    } note nb = this
    {
      let ?L = "literal_formula_to_literal (encode_state_variable 0 (index ?vs v) (?I v))"
      have τ_0_is: " ! 0 = ?I"
        using trace_parallel_plan_strips_head_is_initial_state
        by blast
      have v_in_dom_I: "v  dom ?I"
        using is_valid_problem_strips_initial_of_dom assms(1) v_in_set_vs
        by fastforce
      then consider (I_v_is_Some_True) "?I v = Some True"
        | (I_v_is_Some_False) "?I v = Some False"
        by fastforce
      hence "lit_semantics 𝒜 ?L"
          unfolding encode_state_variable_def
          using assms(3) τ_0_is nb
          by (cases, force+)
    }
    hence "clause_semantics 𝒜 C"
      unfolding clause_semantics_def C_is
      by blast
  }
  thus ?thesis
    using is_cnf_encode_initial_state[OF assms(1)] is_nnf_cnf cnf_semantics
    unfolding cnf_semantics_def
    by blast
qed

― ‹ Plans may terminate early (i.e. by reaching a state satisfying the goal state before
reaching the time point corresponding to the plan length). We therefore have to show the goal by
splitting cases on whether the plan successfully terminated early.
If not, we can just derive the goal from the assumptions pertaining to 𝒜› Otherwise, we
have to first show that the goal was reached (albeit early) and that our valuation 𝒜›
reflects the termination of plan execution after the time point at which the goal was reached. ›
lemma encode_problem_parallel_complete_ii:
  fixes Π::"'a strips_problem"
  assumes "is_valid_problem_strips Π"
    and "(Π)G m execute_parallel_plan ((Π)I) π"
    and "v k. k < length (trace_parallel_plan_strips ((Π)I) π)
       (𝒜 (State k (index (strips_problem.variables_of Π) v))
           (trace_parallel_plan_strips ((Π)I) π ! k) v = Some True)"
    and "v l. l  length (trace_parallel_plan_strips ((Π)I) π)  l < length π + 1
       𝒜 (State l (index (strips_problem.variables_of Π) v))
        = 𝒜 (State (length (trace_parallel_plan_strips ((Π)I) π) - 1)
          (index (strips_problem.variables_of Π) v))"
  shows "𝒜  (ΦG Π)(length π)"
proof -
  let ?vs = "strips_problem.variables_of Π"
    and ?I = "(Π)I"
    and ?G = "(Π)G"
    and I = "ΦI Π"
    and ?t = "length π"
    and G = "(ΦG Π) (length π)"
  let  = "trace_parallel_plan_strips ?I π"
  let ?t' = "length "
  {
    fix v
    assume G_of_v_is_not_None: "?G v  None"
    have "?G m last "
      using execute_parallel_plan_reaches_goal_iff_goal_is_last_element_of_trace assms(2)
      by blast
    also have " =  ! (?t' - 1)"
      using last_conv_nth[OF trace_parallel_plan_strips_not_nil].
    finally have "?G m  ! (?t' - 1)"
      by argo
    hence "( ! (?t' - 1)) v = ?G v"
      using G_of_v_is_not_None
      unfolding map_le_def
      by force
  } note nb1 = this
  (* TODO refactor. *)
  ― ‹ Discriminate on whether the trace has full length or not and show that the model
  valuation of the state variables always correspond to the (defined) goal state values. ›
  {
    fix v
    assume G_of_v_is_not_None: "?G v  None"
    hence "𝒜 (State ?t (index ?vs v))  ?G v = Some True"
      proof (cases "?t' = ?t + 1")
        case True
        moreover have "?t < ?t'"
          using calculation
          by fastforce
        moreover have "𝒜 (State ?t (index ?vs v))  ( ! ?t) v = Some True"
          using assms(3) calculation(2)
          by blast
        ultimately show ?thesis
          using nb1[OF G_of_v_is_not_None]
          by force
      next
        case False
        {
          have "?t' < ?t + 1"
            using length_trace_parallel_plan_strips_lte_length_plan_plus_one False
              le_neq_implies_less
            by blast
          moreover have "𝒜 (State ?t (index ?vs v)) = 𝒜 (State (?t' - 1) (index ?vs v))"
            using assms(4) calculation
            by simp
          moreover have "?t' - 1 < ?t'"
            using trace_parallel_plan_strips_not_nil length_greater_0_conv[of ]
              less_diff_conv2[of 1 ?t' ?t']
            by force
          moreover have "𝒜 (State (?t' - 1) (index ?vs v))  ( ! (?t' - 1)) v = Some True"
            using assms(3) calculation(3)
            by blast
          ultimately have "𝒜 (State ?t (index ?vs v))  ( ! (?t' - 1)) v = Some True"
            by blast
        }
        thus ?thesis
          using nb1[OF G_of_v_is_not_None]
          by presburger
      qed
  } note nb2 = this
  {
    fix C
    assume C_in_cnf_of_ΦG: "C  cnf G"

    moreover obtain v
      where "v  set ?vs"
        and G_of_v_is_not_None: "?G v  None"
      and C_is: "C = { literal_formula_to_literal (encode_state_variable ?t (index ?vs v)
        (?G v)) }"
      using cnf_of_encode_goal_state_set_ii[OF assms(1)] calculation
      by auto
    consider (G_of_v_is_Some_True) "?G v = Some True"
      | (G_of_v_is_Some_False) "?G v = Some False"
      using G_of_v_is_not_None
      by fastforce
    then have "clause_semantics 𝒜 C"
      using nb2 C_is
      unfolding clause_semantics_def encode_state_variable_def
      by (cases, force+)
  }
  thus ?thesis
    using cnf_semantics[OF is_nnf_cnf[OF encode_goal_state_is_cnf[OF assms(1)]]]
    unfolding cnf_semantics_def
    by blast
qed

― ‹ We are not using the full characterization of 𝒜› here since it's not needed. ›
(* TODO make private *)
lemma encode_problem_parallel_complete_iii_a:
  fixes Π::"'a strips_problem"
  assumes "is_valid_problem_strips Π"
    and "(Π)G m execute_parallel_plan ((Π)I) π"
    and "C  cnf (encode_all_operator_preconditions Π (strips_problem.operators_of Π) (length π))"
    and "k op. k < length (trace_parallel_plan_strips ((Π)I) π) - 1
       𝒜 (Operator k (index (strips_problem.operators_of Π) op)) = (op  set (π ! k))"
    and "l op. l  length (trace_parallel_plan_strips ((Π)I) π) - 1  l < length π
       ¬𝒜 (Operator l (index (strips_problem.operators_of Π) op))"
    and "v k. k < length (trace_parallel_plan_strips ((Π)I) π)
        (𝒜 (State k (index (strips_problem.variables_of Π) v))
           (trace_parallel_plan_strips ((Π)I) π ! k) v = Some True)"
  shows "clause_semantics 𝒜 C"
proof -
  let ?ops = "strips_problem.operators_of Π"
    and ?vs = "strips_problem.variables_of Π"
    and ?t = "length π"
  let  = "trace_parallel_plan_strips ((Π)I) π"
  (* TODO slow. *)
  obtain k op
    where k_and_op_are: "(k, op)  ({0..<?t} × set ((Π)𝒪))"
      and "C  (v  set (precondition_of op). {{ (Operator k (index ?ops op))¯
        , (State k (index ?vs v))+ }})"
    using cnf_of_encode_all_operator_preconditions_structure assms(3)
      UN_E[of C ]
    by auto
  then obtain v
    where v_in_preconditions_of_op: "v  set (precondition_of op)"
      and C_is: "C = { (Operator k (index ?ops op))¯, (State k (index ?vs v))+ }"
    by blast
  thus ?thesis
    proof (cases "k < length  - 1")
      case k_lt_length_τ_minus_one: True
      thus ?thesis
        proof (cases "op  set (π ! k)")
          case True
          {
            have "are_all_operators_applicable ( ! k) (π ! k)"
              using trace_parallel_plan_strips_operator_preconditions k_lt_length_τ_minus_one
              by blast
            then have "( ! k) v = Some True"
              using are_all_operators_applicable_set v_in_preconditions_of_op True
              by fast
            hence "𝒜 (State k (index ?vs v))"
              using assms(6) k_lt_length_τ_minus_one
              by force
          }
          thus ?thesis
            using C_is
            unfolding clause_semantics_def
            by fastforce
        next
          case False
          then have "¬𝒜 (Operator k (index ?ops op))"
            using assms(4) k_lt_length_τ_minus_one
            by blast
          thus ?thesis
            using C_is
            unfolding clause_semantics_def
            by fastforce
        qed
    next
      case False
      then have "k  length  - 1" "k < ?t"
        using k_and_op_are
        by(force, simp)
      then have "¬𝒜 (Operator k (index ?ops op))"
        using assms(5)
        by blast
      thus ?thesis
        unfolding clause_semantics_def
        using C_is
        by fastforce
    qed
qed

― ‹ We are not using the full characterization of 𝒜› here since it's not needed. ›
(* TODO make private *)
lemma encode_problem_parallel_complete_iii_b:
  fixes Π::"'a strips_problem"
  assumes "is_valid_problem_strips Π"
    and "(Π)G m execute_parallel_plan ((Π)I) π"
    and "C  cnf (encode_all_operator_effects Π (strips_problem.operators_of Π) (length π))"
    and "k op. k < length (trace_parallel_plan_strips ((Π)I) π) - 1
       𝒜 (Operator k (index (strips_problem.operators_of Π) op)) = (op  set (π ! k))"
    and "l op. l  length (trace_parallel_plan_strips ((Π)I) π) - 1  l < length π
       ¬𝒜 (Operator l (index (strips_problem.operators_of Π) op))"
    and "v k. k < length (trace_parallel_plan_strips ((Π)I) π)
        (𝒜 (State k (index (strips_problem.variables_of Π) v))
           (trace_parallel_plan_strips ((Π)I) π ! k) v = Some True)"
  shows "clause_semantics 𝒜 C"
proof -
  let ?ops = "strips_problem.operators_of Π"
    and ?vs = "strips_problem.variables_of Π"
    and ?t = "length π"
  let  = "trace_parallel_plan_strips ((Π)I) π"
  let ?A = "((k, op)  {0..<?t} × set ((Π)𝒪).
    v  set (add_effects_of op).
      {{ (Operator k (index ?ops op))¯, (State (Suc k) (index ?vs v))+ }})"
    and ?B = "((k, op)  {0..<?t} × set ((Π)𝒪).
      v  set (delete_effects_of op).
         {{ (Operator k (index ?ops op))¯, (State (Suc k) (index ?vs v))¯ }})"
  consider (C_in_A) "C  ?A"
    | (C_in_B) "C  ?B"
    using Un_iff[of C ?A ?B] cnf_of_encode_all_operator_effects_structure assms(3)
     by (metis C_in_A C_in_B)
  thus ?thesis
    proof (cases)
      case C_in_A
      then obtain k op
        where k_and_op_are: "(k, op)  {0..<?t} × set((Π)𝒪)"
          and "C  (v  set (add_effects_of op).
            {{ (Operator k (index ?ops op))¯, (State (Suc k) (index ?vs v))+ }})"
        by blast
      then obtain v where v_in_add_effects_of_op: "v  set (add_effects_of op)"
        and C_is: "C = { (Operator k (index ?ops op))¯, (State (Suc k) (index ?vs v))+ }"
        by blast
      thus ?thesis
        proof (cases "k < length  - 1")
          case k_lt_length_τ_minus_one: True
          thus ?thesis
            proof (cases "op  set (π ! k)")
              case True
              {
                then have "are_all_operators_applicable ( ! k) (π ! k)"
                  and "are_all_operator_effects_consistent (π ! k)"
                  using trace_parallel_plan_strips_operator_preconditions k_lt_length_τ_minus_one
                  by blast+
                hence "execute_parallel_operator ( ! k) (π ! k) v = Some True"
                  using execute_parallel_operator_positive_effect_if[
                    OF _ _ True v_in_add_effects_of_op, of " ! k"]
                  by blast
              }
              then have τ_Suc_k_is_Some_True: "( ! Suc k) v = Some True"
                using trace_parallel_plan_step_effect_is[OF k_lt_length_τ_minus_one]
                by argo
              have "𝒜 (State (Suc k) (index ?vs v))"
                using assms(6) k_lt_length_τ_minus_one τ_Suc_k_is_Some_True
                by fastforce
              thus ?thesis
                using C_is
                unfolding clause_semantics_def
                by fastforce
            next
              case False
              then have "¬𝒜 (Operator k (index ?ops op))"
                using assms(4) k_lt_length_τ_minus_one
                by blast
              thus ?thesis
                using C_is
                unfolding clause_semantics_def
                by force
            qed
        next
          case False
          then have "k  length  - 1" and "k < ?t"
            using k_and_op_are
            by auto
          then have "¬𝒜 (Operator k (index ?ops op))"
            using assms(5)
            by blast
          thus ?thesis
            using C_is
            unfolding clause_semantics_def
            by fastforce
        qed
    next
      ― ‹ This case is completely symmetrical to the one above. ›
      case C_in_B
      then obtain k op
        where k_and_op_are: "(k, op)  {0..<?t} × set ((Π)𝒪)"
          and "C  (v  set (delete_effects_of op).
            {{ (Operator k (index ?ops op))¯, (State (Suc k) (index ?vs v))¯ }})"
        by blast
      then obtain v where v_in_delete_effects_of_op: "v  set (delete_effects_of op)"
        and C_is: "C = { (Operator k (index ?ops op))¯, (State (Suc k) (index ?vs v))¯ }"
        by blast
      thus ?thesis
        proof (cases "k < length  - 1")
          case k_lt_length_τ_minus_one: True
          thus ?thesis
            proof (cases "op  set (π ! k)")
              case True
              {
                then have "are_all_operators_applicable ( ! k) (π ! k)"
                  and "are_all_operator_effects_consistent (π ! k)"
                  using trace_parallel_plan_strips_operator_preconditions k_lt_length_τ_minus_one
                  by blast+
                hence "execute_parallel_operator ( ! k) (π ! k) v = Some False"
                  using execute_parallel_operator_negative_effect_if[
                    OF _ _ True v_in_delete_effects_of_op, of " ! k"]
                  by blast
              }
              then have τ_Suc_k_is_Some_True: "( ! Suc k) v = Some False"
                using trace_parallel_plan_step_effect_is[OF k_lt_length_τ_minus_one]
                by argo
              have "¬𝒜 (State (Suc k) (index ?vs v))"
                using assms(6) k_lt_length_τ_minus_one τ_Suc_k_is_Some_True
                by fastforce
              thus ?thesis
                using C_is
                unfolding clause_semantics_def
                by fastforce
            next
              case False
              then have "¬𝒜 (Operator k (index ?ops op))"
                using assms(4) k_lt_length_τ_minus_one
                by blast
              thus ?thesis
                using C_is
                unfolding clause_semantics_def
                by force
            qed
        next
          case False
          then have "k  length  - 1" and "k < ?t"
            using k_and_op_are
            by auto
          then have "¬𝒜 (Operator k (index ?ops op))"
            using assms(5)
            by blast
          thus ?thesis
            using C_is
            unfolding clause_semantics_def
            by fastforce
        qed
    qed
qed

(* TODO make private *)
lemma encode_problem_parallel_complete_iii:
  fixes Π::"'a strips_problem"
  assumes "is_valid_problem_strips Π"
    and "(Π)G m execute_parallel_plan ((Π)I) π"
    and "k op. k < length (trace_parallel_plan_strips ((Π)I) π) - 1
       𝒜 (Operator k (index (strips_problem.operators_of Π) op)) = (op  set (π ! k))"
    and "l op. l  length (trace_parallel_plan_strips ((Π)I) π) - 1  l < length π
       ¬𝒜 (Operator l (index (strips_problem.operators_of Π) op))"
    and "v k. k < length (trace_parallel_plan_strips ((Π)I) π)
        (𝒜 (State k (index (strips_problem.variables_of Π) v))
           (trace_parallel_plan_strips ((Π)I) π ! k) v = Some True)"
  shows "𝒜  encode_operators Π (length π)"
proof -
  let ?t = "length π"
    and ?ops = "strips_problem.operators_of Π"
  let O = "encode_operators Π ?t"
    and P = "encode_all_operator_preconditions Π ?ops?t"
    and E = "encode_all_operator_effects Π ?ops ?t"
  {
    fix C
    assume "C  cnf O"
    then consider (C_in_precondition_encoding) "C  cnf P"
      | (C_in_effect_encoding) "C  cnf E"
      using cnf_of_operator_encoding_structure
      by blast
    hence "clause_semantics 𝒜 C"
      proof (cases)
        case C_in_precondition_encoding
        thus ?thesis
          using encode_problem_parallel_complete_iii_a[OF assms(1, 2) _ assms(3, 4, 5)]
          by blast
      next
        case C_in_effect_encoding
        thus ?thesis
          using encode_problem_parallel_complete_iii_b[OF assms(1, 2) _ assms(3, 4, 5)]
          by blast
      qed
  }
  thus ?thesis
    using encode_operators_is_cnf[OF assms(1)] is_nnf_cnf cnf_semantics
    unfolding cnf_semantics_def
    by blast
qed

(* TODO make private *)
lemma encode_problem_parallel_complete_iv_a:
  fixes Π :: "'a strips_problem"
  assumes "STRIPS_Semantics.is_parallel_solution_for_problem Π π"
    and "k op. k < length (trace_parallel_plan_strips ((Π)I) π) - 1
       𝒜 (Operator k (index (strips_problem.operators_of Π) op)) = (op  set (π ! k))"
    and "v k. k < length (trace_parallel_plan_strips ((Π)I) π)
        (𝒜 (State k (index (strips_problem.variables_of Π) v))
           (trace_parallel_plan_strips ((Π)I) π ! k) v = Some True)"
    and "v l. l  length (trace_parallel_plan_strips ((Π)I) π)  l < length π + 1
       𝒜 (State l (index (strips_problem.variables_of Π) v))
        = 𝒜 (State
          (length (trace_parallel_plan_strips ((Π)I) π) - 1)
          (index (strips_problem.variables_of Π) v))"
    and "C   ((k, v)  {0..<length π} × set ((Π)𝒱).
      {{{ (State k (index (strips_problem.variables_of Π) v))+
          , (State (Suc k) (index (strips_problem.variables_of Π) v))¯ }
         { (Operator k (index (strips_problem.operators_of Π) op))+
          |op. op  set ((Π)𝒪)  v  set (add_effects_of op) }}})"
  shows "clause_semantics 𝒜 C"
proof -
  let ?vs = "strips_problem.variables_of Π"
    and ?ops = "strips_problem.operators_of Π"
    and ?t = "length π"
  let  = "trace_parallel_plan_strips ((Π)I) π"
  let ?A = "((k, v)  {0..<?t} × set ?vs.
    {{{ (State k (index ?vs v))+, (State (Suc k) (index ?vs v))¯ }
       { (Operator k (index ?ops op))+ |op. op  set ?ops  v  set (add_effects_of op) }}})"
  (* TODO refactor *)
  {
    (* TODO slow *)
    obtain C' where "C'  ?A" and C_in_C': "C  C'"
      using Union_iff assms(5)
      by auto
    then obtain k v
      where "(k, v)  {0..<?t} × set ?vs"
      and "C'  {{{ (State k (index ?vs v))+, (State (Suc k) (index ?vs v))¯ }
         { (Operator k (index ?ops op))+ |op. op  set ?ops  v  set (add_effects_of op) }}}"
      using UN_E
      by blast
    hence "k v.
      k  {0..<?t}
       v  set ?vs
       C = { (State k (index ?vs v))+, (State (Suc k) (index ?vs v))¯ }
         { (Operator k (index ?ops op))+ |op. op  set ?ops  v  set (add_effects_of op) }"
      using C_in_C'
      by blast
  }
  then obtain k v
    where k_in: "k  {0..<?t}"
      and v_in_vs: "v  set ?vs"
      and C_is: "C = { (State k (index ?vs v))+, (State (Suc k) (index ?vs v))¯ }
         { (Operator k (index ?ops op))+ |op. op  set ?ops  v  set (add_effects_of op) }"
    by blast
  show ?thesis
    proof (cases "k < length  - 1")
      case k_lt_length_τ_minus_one: True
      then have k_lt_t: "k < ?t"
        using k_in
        by force
      have all_operators_applicable: "are_all_operators_applicable ( ! k) (π ! k)"
        and all_operator_effects_consistent: "are_all_operator_effects_consistent (π ! k)"
        using trace_parallel_plan_strips_operator_preconditions[OF k_lt_length_τ_minus_one]
        by simp+
      then consider (A) "op  set (π ! k). v  set (add_effects_of op)"
        | (B) "op  set (π ! k). v  set (delete_effects_of op)"
        | (C) "op  set (π ! k). v  set (add_effects_of op)  v  set (delete_effects_of op)"
        by blast
      thus ?thesis
        proof (cases)
          case A
          moreover obtain op
            where op_in_πk: "op  set (π ! k)"
              and v_is_add_effect: "v  set (add_effects_of op)"
            using A
            by blast
          moreover {
            have "(π ! k)  set π"
              using k_lt_t
              by simp
            hence "op  set ?ops"
              using is_parallel_solution_for_problem_operator_set[OF assms(1) _ op_in_πk]
              by blast
          }
          ultimately have "(Operator k (index ?ops op))+
             { (Operator k (index ?ops op))+ | op. op  set ?ops  v  set (add_effects_of op) }"
            using v_is_add_effect
            by blast
          then have "(Operator k (index ?ops op))+  C"
            using C_is
            by auto
          moreover have "𝒜 (Operator k (index ?ops op))"
            using assms(2) k_lt_length_τ_minus_one op_in_πk
            by blast
          ultimately show ?thesis
            unfolding clause_semantics_def
            by force
        next
          case B
          then obtain op
            where op_in_πk: "op  set (π ! k)"
              and v_is_delete_effect: "v  set (delete_effects_of op)"..
          then have "¬(op  set (π ! k). v  set (add_effects_of op))"
            using all_operator_effects_consistent are_all_operator_effects_consistent_set
            by fast
          then have "execute_parallel_operator ( ! k) (π ! k) v
             = Some False"
            using execute_parallel_operator_negative_effect_if[OF all_operators_applicable
                all_operator_effects_consistent op_in_πk v_is_delete_effect]
            by blast
          moreover have "( ! Suc k) v = execute_parallel_operator ( ! k) (π ! k) v"
            using trace_parallel_plan_step_effect_is[OF k_lt_length_τ_minus_one]
            by simp
          ultimately have "¬𝒜 (State (Suc k) (index ?vs v))"
            using assms(3) k_lt_length_τ_minus_one
            by simp
          thus ?thesis
            using C_is
            unfolding clause_semantics_def
            by simp
        next
          case C
          show ?thesis
            proof (cases "( ! k) v = Some True")
              case True
              then have "𝒜 (State k (index ?vs v))"
                using assms(3) k_lt_length_τ_minus_one
                by force
              thus ?thesis
                using C_is
                unfolding clause_semantics_def
                by fastforce
            next
              case False
              {
                have "( ! Suc k) = execute_parallel_operator ( ! k) (π ! k)"
                  using trace_parallel_plan_step_effect_is[OF k_lt_length_τ_minus_one].
                then have "( ! Suc k) v = ( ! k) v"
                  using execute_parallel_operator_no_effect_if C
                  by fastforce
                hence "( ! Suc k) v  Some True"
                  using False
                  by argo
              }
              then have "¬𝒜 (State (Suc k) (index ?vs v))"
                using assms(3) k_lt_length_τ_minus_one
                by auto
              thus ?thesis
                using C_is
                unfolding clause_semantics_def
                by fastforce
            qed
        qed
    next
      case k_gte_length_τ_minus_one: False
      show ?thesis
        proof (cases "𝒜 (State (length  - 1) (index ?vs v))")
          case True
          {
            have "𝒜 (State k (index ?vs v)) = 𝒜 (State (length  - 1) (index ?vs v))"
              proof (cases "k = length  - 1")
                case False
                then have "length   k" and "k < ?t + 1"
                  using k_gte_length_τ_minus_one k_in
                  by fastforce+
                thus ?thesis
                  using assms(4)
                  by blast
              qed blast
            hence "𝒜 (State k (index ?vs v))"
              using True
              by blast
          }
          thus ?thesis
            using C_is
            unfolding clause_semantics_def
            by simp
        next
          case False
          {
            have "length   Suc k" and "Suc k < ?t + 1"
              using k_gte_length_τ_minus_one k_in
              by fastforce+
            then have "𝒜 (State (Suc k) (index ?vs v)) = 𝒜 (State (length  - 1) (index ?vs v))"
              using assms(4)
              by blast
            hence "¬𝒜 (State (Suc k) (index ?vs v))"
              using False
              by blast
          }
          thus ?thesis
            using C_is
            unfolding clause_semantics_def
            by fastforce
        qed
    qed
qed

(* TODO make private *)
lemma encode_problem_parallel_complete_iv_b:
  fixes Π :: "'a strips_problem"
  assumes "is_parallel_solution_for_problem Π π"
    and "k op. k < length (trace_parallel_plan_strips ((Π)I) π) - 1
       𝒜 (Operator k (index (strips_problem.operators_of Π) op)) = (op  set (π ! k))"
    and "v k. k < length (trace_parallel_plan_strips ((Π)I) π)
        (𝒜 (State k (index (strips_problem.variables_of Π) v))
           (trace_parallel_plan_strips ((Π)I) π ! k) v = Some True)"
    and "v l. l  length (trace_parallel_plan_strips ((Π)I) π)  l < length π + 1
       𝒜 (State l (index (strips_problem.variables_of Π) v))
        = 𝒜 (State
          (length (trace_parallel_plan_strips ((Π)I) π) - 1)
          (index (strips_problem.variables_of Π) v))"
    and "C   ((k, v)  {0..<length π} × set ((Π)𝒱).
      {{{ (State k (index (strips_problem.variables_of Π) v))¯
          , (State (Suc k) (index (strips_problem.variables_of Π) v))+ }
         { (Operator k (index (strips_problem.operators_of Π) op))+
          |op. op  set ((Π)𝒪)  v  set (delete_effects_of op) }}})"
  shows "clause_semantics 𝒜 C"
proof -
  let ?vs = "strips_problem.variables_of Π"
    and ?ops = "strips_problem.operators_of Π"
    and ?t = "length π"
  let  = "trace_parallel_plan_strips (initial_of Π) π"
  let ?A = "((k, v)  {0..<?t} × set ?vs.
    {{{ (State k (index ?vs v))¯, (State (Suc k) (index ?vs v))+ }
       { (Operator k (index ?ops op))+
        | op. op  set ((Π)𝒪)  v  set (delete_effects_of op) }}})"
  (* TODO refactor *)
  {
    (* TODO slow *)
    obtain C' where "C'  ?A" and C_in_C': "C  C'"
      using Union_iff assms(5)
      by auto
    (* TODO slow *)
    then obtain k v
      where "(k, v)  {0..<?t} × set ?vs"
      and "C'  {{{ (State k (index ?vs v))¯, (State (Suc k) (index ?vs v))+ }
         { (Operator k (index ?ops op))+ |op. op  set ?ops  v  set (delete_effects_of op) }}}"
      using UN_E
      by fastforce
    hence "k v.
      k  {0..<?t}
       v  set ?vs
       C = { (State k (index ?vs v))¯, (State (Suc k) (index ?vs v))+ }
         { (Operator k (index ?ops op))+
          | op. op  set ((Π)𝒪)  v  set (delete_effects_of op) }"
      using C_in_C'
      by auto
  }
  then obtain k v
    where k_in: "k  {0..<?t}"
      and v_in_vs: "v  set ((Π)𝒱)"
      and C_is: "C = { (State k (index ?vs v))¯, (State (Suc k) (index ?vs v))+ }
         { (Operator k (index ?ops op))+
          | op. op  set ((Π)𝒪)  v  set (delete_effects_of op) }"
    by auto
  show ?thesis
    proof (cases "k < length  - 1")
      case k_lt_length_τ_minus_one: True
      then have k_lt_t: "k < ?t"
        using k_in
        by force
      have all_operators_applicable: "are_all_operators_applicable ( ! k) (π ! k)"
        and all_operator_effects_consistent: "are_all_operator_effects_consistent (π ! k)"
        using trace_parallel_plan_strips_operator_preconditions[OF k_lt_length_τ_minus_one]
        by simp+
      then consider (A) "op  set (π ! k). v  set (delete_effects_of op)"
        | (B) "op  set (π ! k). v  set (add_effects_of op)"
        | (C) "op  set (π ! k). v  set (add_effects_of op)  v  set (delete_effects_of op)"
        by blast
      thus ?thesis
        proof (cases)
          case A
          moreover obtain op
            where op_in_πk: "op  set (π ! k)"
              and v_is_delete_effect: "v  set (delete_effects_of op)"
            using A
            by blast
          moreover {
            have "(π ! k)  set π"
              using k_lt_t
              by simp
            hence "op  set ?ops"
              using is_parallel_solution_for_problem_operator_set[OF assms(1) _ op_in_πk]
              by auto
          }
          ultimately have "(Operator k (index ?ops op))+
             { (Operator k (index ?ops op))+
              | op. op  set ?ops  v  set (delete_effects_of op) }"
            using v_is_delete_effect
            by blast
          then have "(Operator k (index ?ops op))+  C"
            using C_is
            by auto
          moreover have "𝒜 (Operator k (index ?ops op))"
            using assms(2) k_lt_length_τ_minus_one op_in_πk
            by blast
          ultimately show ?thesis
            unfolding clause_semantics_def
            by force
        next
          case B
          then obtain op
            where op_in_πk: "op  set (π ! k)"
              and v_is_add_effect: "v  set (add_effects_of op)"..
          then have "¬(op  set (π ! k). v  set (delete_effects_of op))"
            using all_operator_effects_consistent are_all_operator_effects_consistent_set
            by fast
          then have "execute_parallel_operator ( ! k) (π ! k) v = Some True"
            using execute_parallel_operator_positive_effect_if[OF all_operators_applicable
                all_operator_effects_consistent op_in_πk v_is_add_effect]
            by blast
          moreover have "( ! Suc k) v = execute_parallel_operator ( ! k) (π ! k) v"
            using trace_parallel_plan_step_effect_is[OF k_lt_length_τ_minus_one]
            by simp
          ultimately have "𝒜 (State (Suc k) (index ?vs v))"
            using assms(3) k_lt_length_τ_minus_one
            by simp
          thus ?thesis
            using C_is
            unfolding clause_semantics_def
            by simp
        next
          case C
          show ?thesis
            ― ‹ We split on cases for @{text "(?τ ! k) v = Some True"} here to avoid having to
              proof @{text "(?τ ! k) v ≠ None"}. ›
            proof (cases "( ! k) v = Some True")
              case True
              {
                have "( ! Suc k) = execute_parallel_operator ( ! k) (π ! k)"
                  using trace_parallel_plan_step_effect_is[OF k_lt_length_τ_minus_one].
                then have "( ! Suc k) v = ( ! k) v"
                  using execute_parallel_operator_no_effect_if C
                  by fastforce
                then have "( ! Suc k) v = Some True"
                  using True
                  by argo
                hence "𝒜 (State (Suc k) (index ?vs v))"
                  using assms(3) k_lt_length_τ_minus_one
                  by fastforce
              }
              thus ?thesis
                using C_is
                unfolding clause_semantics_def
                by fastforce
            next
              case False
              then have "¬𝒜 (State k (index ?vs v))"
                using assms(3) k_lt_length_τ_minus_one
                by simp
              thus ?thesis
                using C_is
                unfolding clause_semantics_def
                by fastforce
            qed
        qed
    next
      case k_gte_length_τ_minus_one: False
      show ?thesis
        proof (cases "𝒜 (State (length  - 1) (index ?vs v))")
          case True
          {
            have "length   Suc k" and "Suc k < ?t + 1"
              using k_gte_length_τ_minus_one k_in
              by fastforce+
            then have "𝒜 (State (Suc k) (index ?vs v)) = 𝒜 (State (length  - 1) (index ?vs v))"
              using assms(4)
              by blast
            hence "𝒜 (State (Suc k) (index ?vs v))"
              using True
              by blast
          }
          thus ?thesis
            using C_is
            unfolding clause_semantics_def
            by fastforce
        next
          case False
          {
            have "𝒜 (State k (index ?vs v)) = 𝒜 (State (length  - 1) (index ?vs v))"
              proof (cases "k = length  - 1")
                case False
                then have "length   k" and "k < ?t + 1"
                  using k_gte_length_τ_minus_one k_in
                  by fastforce+
                thus ?thesis
                  using assms(4)
                  by blast
              qed blast
            hence "¬𝒜 (State k (index ?vs v))"
              using False
              by blast
          }
          thus ?thesis
            using C_is
            unfolding clause_semantics_def
            by simp
        qed
    qed
qed

(* TODO make private *)
lemma encode_problem_parallel_complete_iv:
  fixes Π::"'a strips_problem"
  assumes "is_valid_problem_strips Π"
    and "is_parallel_solution_for_problem Π π"
    and "k op. k < length (trace_parallel_plan_strips ((Π)I) π) - 1
       𝒜 (Operator k (index (strips_problem.operators_of Π) op)) = (op  set (π ! k))"
    and "v k. k < length (trace_parallel_plan_strips ((Π)I) π)
        (𝒜 (State k (index (strips_problem.variables_of Π) v))
           (trace_parallel_plan_strips ((Π)I) π ! k) v = Some True)"
    and "v l. l  length (trace_parallel_plan_strips ((Π)I) π)  l < length π + 1
       𝒜 (State l (index (strips_problem.variables_of Π) v))
        = 𝒜 (State
          (length (trace_parallel_plan_strips ((Π)I) π) - 1)
          (index (strips_problem.variables_of Π) v))"
  shows "𝒜  encode_all_frame_axioms Π (length π)"
proof -
  let F = "encode_all_frame_axioms Π (length π)"
  let ?vs = "strips_problem.variables_of Π"
    and ?ops = "strips_problem.operators_of Π"
    and ?t = "length π"
  let ?A = " ((k, v)  {0..<?t} × set ((Π)𝒱).
    {{{ (State k (index ?vs v))+, (State (Suc k) (index ?vs v))¯ }
       { (Operator k (index ?ops op))+
        | op. op  set ((Π)𝒪)  v  set (add_effects_of op) }}})"
    and ?B = " ((k, v)  {0..<?t} × set ((Π)𝒱).
      {{{ (State k (index ?vs v))¯, (State (Suc k) (index ?vs v))+ }
         { (Operator k (index ?ops op))+
          | op. op  set ((Π)𝒪)  v  set (delete_effects_of op) }}})"
  (* TODO slow (and why can only metis do this?). *)
  have cnf_ΦF_is_A_union_B: "cnf F = ?A  ?B"
    using cnf_of_encode_all_frame_axioms_structure
    by (simp add: cnf_of_encode_all_frame_axioms_structure)
  {
    fix C
    assume "C  cnf F"
    then consider (C_in_A) "C  ?A"
      | (C_in_B) "C  ?B"
      using Un_iff[of C ?A ?B] cnf_ΦF_is_A_union_B
      by argo
    hence "clause_semantics 𝒜 C"
      proof (cases)
        case C_in_A
        then show ?thesis
          using encode_problem_parallel_complete_iv_a[OF assms(2, 3, 4, 5) C_in_A]
          by blast
      next
        case C_in_B
        then show ?thesis
          using encode_problem_parallel_complete_iv_b[OF assms(2, 3, 4, 5) C_in_B]
          by blast
      qed
  }
  thus ?thesis
    using encode_frame_axioms_is_cnf is_nnf_cnf cnf_semantics
    unfolding cnf_semantics_def
    by blast
qed

(* TODO refactor. *)
lemma valuation_for_operator_variables_is:
  fixes Π :: "'a strips_problem"
  assumes "is_parallel_solution_for_problem Π π"
    and "k < length (trace_parallel_plan_strips ((Π)I) π) - 1"
    and "op  set ((Π)𝒪)"
  shows "valuation_for_operator_variables Π π (trace_parallel_plan_strips ((Π)I) π)
      (Operator k (index (strips_problem.operators_of Π) op))
    = (op  set (π ! k))"
proof -
  let ?ops = "strips_problem.operators_of Π"
    and  = "trace_parallel_plan_strips ((Π)I) π"
  let ?v = "Operator k (index ?ops op)"
    and ?Op = "{ Operator k (index ?ops op)
      | k op. k  {0..<length  - 1}  op  set ((Π)𝒪) }"
  let ?l = "concat (map (λk. map (Pair k) (π ! k)) [0..<length  - 1])"
    and ?f = "λx. Operator (fst x) (index ?ops (snd x))"
  ― ‹ show that our operator construction function is injective on
    @{text "set (concat (map (λk. map (Pair k) (π ! k)) [0..<length ?τ - 1]))"}. ›
  have k_in: "k  {0..<length  - 1}"
    using assms(2)
    by fastforce
  {
    (* TODO refactor. *)
    {
      fix k k' op op'
      assume k_op_in: "(k, op)  set ?l" and k'_op'_in: "(k', op')  set ?l"
      have "Operator k (index ?ops op) = Operator k' (index ?ops op')  (k, op) = (k', op')"
        proof (rule iffI)
          assume index_op_is_index_op': "Operator k (index ?ops op) = Operator k' (index ?ops op')"
          then have k_is_k': "k = k'"
            by fast
          moreover {
            have k'_lt: "k' < length  - 1"
              using k'_op'_in
              by fastforce
            (* TODO slow *)
            have op_in: "op  set (π ! k)"
              using k_op_in
              by force
            (* TODO slow *)
            then have op'_in: "op'  set (π ! k)"
              using k'_op'_in k_is_k'
              by auto
            {
              have length_τ_gt_1: "length  > 1"
                using assms(2)
                by linarith
              have "length  - Suc 0  length π + 1 - Suc 0"
                using length_trace_parallel_plan_strips_lte_length_plan_plus_one
                using diff_le_mono
                by blast
              then have "length  - 1  length π"
                by fastforce
              then have "k' < length π"
                using length_τ_gt_1 k'_lt
                by linarith
              hence "π ! k'  set π"
                by simp
            }
            moreover have "op  set ?ops" and "op'  set ?ops"
              using is_parallel_solution_for_problem_operator_set[OF assms(1)] op_in op'_in k_is_k'
                calculation
              by auto
            ultimately have "op = op'"
              using index_op_is_index_op'
              by force
          }
          ultimately show "(k, op) = (k', op')"
            by blast
        qed fast
    }
    (* TODO slow *)
    hence "inj_on ?f (set ?l)"
      unfolding inj_on_def fst_def snd_def
      by fast
  } note inj_on_f_set_l = this
  (* TODO refactor. *)
  {
    have "set ?l =  (set ` set (map (λk. map (Pair k) (π ! k)) [0..<length  - 1]))"
      using set_concat
      by metis
    also have " =  (set ` (λk. map (Pair k) (π ! k)) ` {0..<length  - 1})"
      by force
    also have " =  ((λk. (Pair k) ` set (π ! k)) ` {0..<length  - 1})"
      by force
    also have " = ((λk. { (k, op) | op. op  set (π ! k) }) ` {0..<length  - 1})"
      by blast
    also have " = ({{ (k, op) } | k op. k  {0..<length  - 1}  op  set (π ! k) })"
      by blast
    (* TODO slow. *)
    finally have "set ?l = ((λ(k, op). { (k, op) })
      ` { (k, op). k  {0..<length  - 1}  op  set (π ! k) })"
      using setcompr_eq_image[of "λ(k, op). { (k, op) }" _]
      by auto
  } note set_l_is = this
  {
    have "Operator k (index ?ops op)  ?Op"
      using assms(3) k_in
      by blast
    (* TODO slow *)
    hence "valuation_for_operator_variables Π π  ?v
      = foldr (λ(k, op) 𝒜. 𝒜(Operator k (index ?ops op) := True)) ?l 𝒜0 ?v"
      unfolding valuation_for_operator_variables_def override_on_def Let_def
      by auto
  } note nb = this
  show ?thesis
    proof (cases "op  set (π ! k)")
      case True
      moreover have k_op_in: "(k, op)  set ?l"
        using set_l_is k_in calculation
        by blast
      ― ‹ There is some problem with the pattern match in the lambda in fact \isaname{nb}, sow
        we have to do some extra work to convince Isabelle of the truth of the statement. ›
      moreover {
        let ?g = "λ_. True"
        thm foldr_fun_upd[OF inj_on_f_set_l k_op_in]
        have "?v = Operator (fst (k, op)) (index ?ops (snd (k, op)))"
          by simp
        moreover have "(λ(k, op) 𝒜. 𝒜(Operator k (index ?ops op) := True))
          = (λx 𝒜. 𝒜(Operator (fst x) (index ?ops  (snd x)) := True))"
          by fastforce
        moreover have "foldr (λx 𝒜. 𝒜(Operator (fst x) (index ?ops  (snd x)) := ?g x))
          ?l 𝒜0 (Operator (fst (k, op)) (index ?ops (snd (k, op)))) = True"
          unfolding foldr_fun_upd[OF inj_on_f_set_l k_op_in]..
        ultimately have "valuation_for_operator_variables Π π  ?v = True"
          using nb
          by argo
      }
      thus ?thesis
        using True
        by blast
    next
      case False
      {
        have "(k, op)  set ?l"
          using False set_l_is
          by fast
        moreover {
          fix k' op'
          assume "(k', op')  set ?l"
            and "?f (k', op') = ?f (k, op)"
          (* TODO slow. *)
          hence "(k', op') = (k, op)"
            using inj_on_f_set_l assms(3)
            by simp
        }
        (* TODO slow. *)
        ultimately have "Operator k (index ?ops op)  ?f ` set ?l"
          using image_iff
          by force
      } note operator_not_in_f_image_set_l = this
      {
        have "𝒜0 (Operator k (index ?ops op)) = False"
          by simp
        moreover have "(λ(k, op) 𝒜. 𝒜(Operator k (index ?ops op) := True))
          = (λx 𝒜. 𝒜(Operator (fst x) (index ?ops (snd x)) := True))"
          by fastforce
        ultimately have "foldr (λ(k, op) 𝒜. 𝒜(Operator k (index ?ops op) := True)) ?l 𝒜0 ?v = False"
          using foldr_fun_no_upd[OF inj_on_f_set_l operator_not_in_f_image_set_l, of "λ_. True" 𝒜0]
          by presburger
      }
      thus ?thesis
      using nb False
      by blast
    qed
qed

(* TODO refactor (also used in proof of completeness for ∀-step 1 encoding)
  TODO make private *)
lemma encode_problem_parallel_complete_vi_a:
  fixes Π :: "'a strips_problem"
  assumes "is_parallel_solution_for_problem Π π"
    and "k < length (trace_parallel_plan_strips ((Π)I) π) - 1"
  shows "valuation_for_plan Π π (Operator k (index (strips_problem.operators_of Π) op))
    = (op  set (π ! k))"
proof -
  let ?vs = "strips_problem.variables_of Π"
    and ?ops = "strips_problem.operators_of Π"
    and ?t = "length π"
    and  = "trace_parallel_plan_strips ((Π)I) π"
  let ?𝒜π = "valuation_for_plan Π π"
    and ?𝒜O = "valuation_for_operator_variables Π π "
    and ?Op = "{ Operator k (index ?ops op) | k op. k  {0..<?t}  op  set ?ops }"
    and ?V = "{ State k (index ?vs v) | k v. k  {0..<?t + 1}  v  set ?vs }"
    and ?v = "Operator k (index ?ops op)"
  {
    have "length   length π + 1"
      using length_trace_parallel_plan_strips_lte_length_plan_plus_one.
    then have "length  - 1  length π"
      by simp
    then have "k < ?t"
      using assms
      by fastforce
  } note k_lt_length_π = this
  show ?thesis
    proof (cases "op  set ((Π)𝒪)")
      case True
      {
        have "?v  ?Op"
          using k_lt_length_π True
          by auto
        (* TODO slow. *)
        hence "?𝒜π ?v = ?𝒜O ?v"
          unfolding valuation_for_plan_def override_on_def Let_def
          by force
      }
      then show ?thesis
        using valuation_for_operator_variables_is[OF assms(1, 2) True]
        by blast
    next
      (* TODO refactor (used in the lemma below as well). *)
      case False
      {
        {
          ― ‹ We have @{text "¬index ?ops op < length ?ops"} due to the assumption that
            @{text "¬op ∈ set ?ops"}. Hence @{text "¬k ∈ {0..<?t"} and therefore
            @{text "?v ∉ ?Op"}. ›
          have "?Op = (λ(k, op). Operator k (index ?ops op)) ` ({0..<?t} × set ?ops)"
            by fast
          moreover have "¬index ?ops op < length ?ops"
            using False
            by simp
          ultimately have "?v  ?Op"
            by fastforce
        }
        moreover have "?v  ?V"
          by force
        (* TODO slow. *)
        ultimately have "?𝒜π ?v = 𝒜0 ?v"
          unfolding valuation_for_plan_def override_on_def
          by metis
        hence "¬?𝒜π ?v"
          unfolding empty_valuation_def
          by blast
      }
      moreover have "(π ! k)  set π"
        using k_lt_length_π
        by simp
      moreover have "op  set (π ! k)"
        using is_parallel_solution_for_problem_operator_set[OF assms(1) calculation(2)] False
        by blast
      ultimately show ?thesis
        by blast
    qed
qed

(* TODO make private *)
lemma encode_problem_parallel_complete_vi_b:
  fixes Π :: "'a strips_problem"
  assumes "is_parallel_solution_for_problem Π π"
    and "l  length (trace_parallel_plan_strips ((Π)I) π) - 1"
    and "l < length π"
  shows "¬valuation_for_plan Π π (Operator l (index (strips_problem.operators_of Π) op))"
proof -
  (* TODO prune variables *)
  let ?vs = "strips_problem.variables_of Π"
    and ?ops = "strips_problem.operators_of Π"
    and ?t = "length π"
    and  = "trace_parallel_plan_strips ((Π)I) π"
  let ?𝒜π = "valuation_for_plan Π π"
    and ?𝒜O = "valuation_for_operator_variables Π π "
    and ?Op = "{ Operator k (index ?ops op) | k op. k  {0..<?t}  op  set ?ops }"
    and ?Op' = "{ Operator k (index ?ops op) | k op. k  {0..<length  - 1}  op  set ?ops }"
    and ?V = "{ State k (index ?vs v) | k v. k  {0..<?t + 1}  v  set ?vs }"
    and ?v = "Operator l (index ?ops op)"
  show ?thesis
    proof (cases "op  set ((Π)𝒪)")
      case True
      {
        {
          have "?v  ?Op"
            using assms(3) True
            by auto
          (* TODO slow. *)
          hence "?𝒜π ?v = ?𝒜O ?v"
            unfolding valuation_for_plan_def override_on_def Let_def
            by simp
        }
        moreover {
          have "l  {0..<length  - 1}"
            using assms(2)
            by simp
          then have "?v  ?Op'"
            by blast
          hence "?𝒜O ?v = 𝒜0 ?v"
            unfolding valuation_for_operator_variables_def override_on_def
            by meson
        }
        ultimately have "¬?𝒜π ?v"
          unfolding empty_valuation_def
          by blast
      }
      then show ?thesis
        by blast
    next
      (* TODO refactor (used in the lemma above as well). *)
      case False
      {
        {
          ― ‹ We have @{text "¬index ?ops op < length ?ops"} due to the assumption that
            @{text "¬op ∈ set ?ops"}. Hence @{text "¬k ∈ {0..<?t"} and therefore
            @{text "?v ∉ ?Op"}. ›
          have "?Op = (λ(k, op). Operator k (index ?ops op)) ` ({0..<?t} × set ?ops)"
            by fast
          moreover have "¬index ?ops op < length ?ops"
            using False
            by simp
          ultimately have "?v  ?Op"
            by fastforce
        }
        moreover have "?v  ?V"
          by force
        (* TODO slow. *)
        ultimately have "?𝒜π ?v = 𝒜0 ?v"
          unfolding valuation_for_plan_def override_on_def
          by metis
        hence "¬?𝒜π ?v"
          unfolding empty_valuation_def
          by blast
      }
      thus ?thesis
        by blast
    qed
qed

― ‹ As a corollary from lemmas \isaname{encode_problem_parallel_complete_vi_a} and
\isaname{encode_problem_parallel_complete_vi_b} we obtain the result that the constructed
valuation term𝒜  valuation_for_plan Π π valuates SATPlan operator variables as false if
they are not contained in any operator set termπ ! k for any time point termk < length π. ›
corollary encode_problem_parallel_complete_vi_d:
  (* TODO why is this necessary? *)
  fixes Π :: "'variable strips_problem"
  assumes "is_parallel_solution_for_problem Π π"
    and "k < length π"
    and "op  set (π ! k)"
  shows "¬valuation_for_plan Π π (Operator k (index (strips_problem.operators_of Π) op))"
  using encode_problem_parallel_complete_vi_a[OF assms(1)] assms(3)
    encode_problem_parallel_complete_vi_b[OF assms(1) _ assms(2)] assms(3)
  by (cases "k < length (trace_parallel_plan_strips ((Π)I) π) - 1"; fastforce)

(* TODO refactor List_Supplement OR rm (unused) *)
lemma list_product_is_nil_iff: "List.product xs ys = []  xs = []  ys = []"
proof (rule iffI)
  assume product_xs_ys_is_Nil: "List.product xs ys = []"
  show "xs = []  ys = []"
    proof (rule ccontr)
      assume "¬(xs = []  ys = [])"
      then have "xs  []" and "ys  []"
        by simp+
      then obtain x xs' y ys' where "xs = x # xs'" and "ys = y # ys'"
        using list.exhaust
        by metis
      then have "List.product xs ys = (x, y) # map (Pair x) ys' @ List.product xs' (y # ys')"
        by simp
      thus False
        using product_xs_ys_is_Nil
        by simp
    qed
next
  assume "xs = []  ys = []"
  thus "List.product xs ys = []"
  ― ‹ First cases in the next two proof blocks follow from definition of List.product. ›
  proof (rule disjE)
    assume ys_is_Nil: "ys = []"
    show "List.product xs ys = []"
      proof (induction xs)
        case (Cons x xs)
        have "List.product (x # xs) ys = map (Pair x) ys @ List.product xs ys"
          by simp
        also have " = [] @ List.product xs ys"
          using Nil_is_map_conv ys_is_Nil
          by blast
        finally show ?case
          using Cons.IH
          by force
      qed auto
  qed simp
qed

― ‹ We keep the state abstract by requiring a function s› which takes the index
k› and returns state. This makes the lemma cover both cases, i.e. dynamic (e.g. the k›-th
trace state) as well as static state (e.g. final trace state). ›
lemma valuation_for_state_variables_is:
  assumes "k  set ks"
    and "v  set vs"
  shows "foldr (λ(k, v) 𝒜. valuation_for_state vs (s k) k v 𝒜) (List.product ks vs) 𝒜0
      (State k (index vs v))
     (s k) v = Some True"
proof -
  let ?v = "State k (index vs v)"
    and ?ps = "List.product ks vs"
  let ?𝒜 = "foldr (λ(k, v) 𝒜. valuation_for_state vs (s k) k v 𝒜) ?ps 𝒜0"
    and ?f = "λx. State (fst x) (index vs (snd x))"
    and ?g = "λx. (s (fst x)) (snd x) = Some True"
  have nb1: "(k, v)  set ?ps"
    using assms(1, 2) set_product
    by simp
  (* TODO refactor (State construction is injective on List.product ks vs). *)
  moreover {
    {
      fix x y
      assume x_in_ps: "x  set ?ps" and y_in_ps: "y  set ?ps"
        and "¬(?f x = ?f y  x = y)"
      then have f_x_is_f_y: "?f x = ?f y" and x_is_not_y: "x  y"
        by blast+
      then obtain k' k'' v' v''
        where x_is: "x = (k', v')"
          and y_is: "y = (k'', v'')"
        by fastforce
      then consider (A) "k'  k''"
        | (B) "v'  v''"
        using x_is_not_y
        by blast
      hence False
        proof (cases)
          case A
          then have "?f x  ?f y"
            using x_is y_is
            by simp
          thus ?thesis
            using f_x_is_f_y
            by argo
        next
          case B
          have "v'  set vs" and "v''  set vs"
            using x_in_ps x_is y_in_ps y_is set_product
            by blast+
          then have "index vs v'  index vs v''"
            using B
            by force
          then have "?f x  ?f y"
            using x_is y_is
            by simp
          thus False
            using f_x_is_f_y
            by blast
        qed
    }
    hence "inj_on ?f (set ?ps)"
      using inj_on_def
      by blast
  } note nb2 = this
  {
    have "foldr (λx. valuation_for_state vs (s (fst x)) (fst x) (snd x))
     (List.product ks vs) 𝒜0 (State (fst (k, v)) (index vs (snd (k, v)))) =
    (s (fst (k, v)) (snd (k, v)) = Some True)"
      using foldr_fun_upd[OF nb2 nb1, of ?g 𝒜0]
      by blast
    moreover have "(λx. valuation_for_state vs (s (fst x)) (fst x) (snd x))
      = (λ(k, v). valuation_for_state vs (s k) k v)"
      by fastforce
    ultimately have "?𝒜 (?f (k, v)) = ?g (k, v)"
      by simp
  }
  thus ?thesis
    by simp
qed

(* TODO make private *)
lemma encode_problem_parallel_complete_vi_c:
  fixes Π :: "'a strips_problem"
  assumes "is_valid_problem_strips Π"
    and "is_parallel_solution_for_problem Π π"
    and "k < length (trace_parallel_plan_strips ((Π)I) π)"
  shows "valuation_for_plan Π π (State k (index (strips_problem.variables_of Π) v))
     (trace_parallel_plan_strips ((Π)I) π ! k) v = Some True"
proof -
  (* TODO prune variables *)
  let ?vs = "strips_problem.variables_of Π"
    and ?ops = "strips_problem.operators_of Π"
    and  = "trace_parallel_plan_strips ((Π)I) π"
  let ?t = "length π"
    and ?t' = "length "
  let ?𝒜π = "valuation_for_plan Π π"
    and ?𝒜V = "valuation_for_state_variables Π π "
    and ?𝒜O = "valuation_for_state_variables Π π "
    and ?𝒜1 = "foldr
      (λ(k, v) 𝒜. valuation_for_state ?vs ( ! k) k v 𝒜)
      (List.product [0..<?t'] ?vs) 𝒜0"
    and ?Op = "{ Operator k (index ?ops op) | k op. k  {0..<?t}  op  set ((Π)𝒪) }"
    and ?Op' = "{ Operator k (index ?ops op) | k op. k  {0..<?t' - 1}  op  set ((Π)𝒪) }"
    and ?V = "{ State k (index ?vs v) | k v. k  {0..<?t + 1}  v  set ((Π)𝒱) }"
    and ?V1 = "{ State k (index ?vs v) | k v. k  {0..<?t'}  v  set ((Π)𝒱) }"
    and ?V2 = "{ State k (index ?vs v) | k v. k  {?t'..(?t + 1)}  v  set ((Π)𝒱) }"
    and ?v = "State k (index ?vs v)"
  have v_notin_Op: "?v  ?Op"
    by blast
  have k_lte_length_π_plus_one: "k < length π + 1"
    using less_le_trans length_trace_parallel_plan_strips_lte_length_plan_plus_one assms(3)
    by blast
  show ?thesis
    proof (cases "v  set ((Π)𝒱)")
      case True
      {
        (* TODO refactor. *)
        {
          have "?v  ?V" "?v  ?Op"
            using k_lte_length_π_plus_one True
            by force+
          hence "?𝒜π ?v = ?𝒜V ?v"
            unfolding valuation_for_plan_def override_on_def Let_def
            by simp
        }
        moreover {
          have "?v  ?V1" "?v  ?V2"
            using assms(3) True
            by fastforce+
          hence "?𝒜V ?v = ?𝒜1 ?v"
            unfolding valuation_for_state_variables_def override_on_def Let_def
            by force
        }
        ultimately have "?𝒜π ?v = ?𝒜1 ?v"
          by blast
      }
      moreover have "k  set [0..<?t']"
        using assms(3)
        by simp
      moreover have "v  set (strips_problem.variables_of Π)"
        using True
        by simp
      (* TODO slow *)
      ultimately show ?thesis
        using valuation_for_state_variables_is[of k "[0..<?t']"]
        by fastforce
    next
      case False
      {
        {
          have "¬ index ?vs v < length ?vs"
            using False index_less_size_conv
            by simp
          hence "?v  ?V"
            by fastforce
        }
        then have "¬?𝒜π ?v"
          using v_notin_Op
          unfolding valuation_for_plan_def override_on_def empty_valuation_def Let_def
             variables_of_def operators_of_def
          by presburger
      }
      moreover have "¬( ! k) v = Some True"
        using trace_parallel_plan_strips_none_if[of Π π k v] assms(1, 2, 3) False
        unfolding initial_of_def
        by force
      ultimately show ?thesis
        by blast
    qed
qed

(* TODO make private *)
lemma encode_problem_parallel_complete_vi_f:
  fixes Π :: "'a strips_problem"
  assumes "is_valid_problem_strips Π"
    and "is_parallel_solution_for_problem Π π"
    and "l  length (trace_parallel_plan_strips ((Π)I) π)"
    and "l < length π + 1"
  shows "valuation_for_plan Π π (State l (index (strips_problem.variables_of Π) v))
    = valuation_for_plan Π π
      (State (length (trace_parallel_plan_strips ((Π)I) π) - 1)
      (index (strips_problem.variables_of Π) v))"
proof -
  (* TODO prune variables *)
  let ?vs = "strips_problem.variables_of Π"
    and ?ops = "strips_problem.operators_of Π"
    and  = "trace_parallel_plan_strips ((Π)I) π"
  let ?t = "length π"
    and ?t' = "length "
  let Ω = " ! (?t' - 1)"
    and ?𝒜π = "valuation_for_plan Π π"
    and ?𝒜V = "valuation_for_state_variables Π π "
    and ?𝒜O = "valuation_for_state_variables Π π "
  let ?𝒜2 = "foldr
    (λ(k, v) 𝒜. valuation_for_state (strips_problem.variables_of Π) Ω k v 𝒜)
    (List.product [?t'..<length π + 2] ?vs)
    𝒜0"
    and ?Op = "{ Operator k (index ?ops op) | k op. k  {0..<?t}  op  set ((Π)𝒪) }"
    and ?Op' = "{ Operator k (index ?ops op) | k op. k  {0..<?t' - 1}  op  set ((Π)𝒪) }"
    and ?V = "{ State k (index ?vs v) | k v. k  {0..<?t + 1}  v  set ((Π)𝒱) }"
    and ?V1 = "{ State k (index ?vs v) | k v. k  {0..<?t'}  v  set ((Π)𝒱) }"
    and ?V2 = "{ State k (index ?vs v) | k v. k  {?t'..(?t + 1)}  v  set ((Π)𝒱) }"
    and ?v = "State l (index ?vs v)"
  have v_notin_Op: "?v  ?Op"
    by blast
  show ?thesis
    proof (cases "v  set ((Π)𝒱)")
      case True
      {
        (* TODO refactor. *)
        {
          have "?v  ?V" "?v  ?Op"
            using assms(4) True
            by force+
          (* TODO slow. *)
          hence "?𝒜π ?v = ?𝒜V ?v"
            unfolding valuation_for_plan_def override_on_def Let_def
            by simp
        }
        moreover {
          have "?v  ?V1" "?v  ?V2"
            using assms(3, 4) True
            by force+
          (* TODO slow. *)
          hence "?𝒜V ?v = ?𝒜2 ?v"
            unfolding valuation_for_state_variables_def override_on_def Let_def
            by auto
        }
        ultimately have "?𝒜π ?v = ?𝒜2 ?v"
          by blast
      } note nb = this
      moreover
      {
        have "l  set [?t'..<?t + 2]"
          using assms(3, 4)
          by auto
        (* TODO slow *)
        hence "?𝒜2 ?v  Ω v = Some True"
          using valuation_for_state_variables_is[of l "[?t'..<?t + 2]"] True nb
          by fastforce
      }
      ultimately have "?𝒜π ?v  Ω v = Some True"
        by fast
      moreover {
        have "0 < ?t'"
          using trace_parallel_plan_strips_not_nil
          by blast
        then have "?t' - 1 < ?t'"
          using diff_less
          by presburger
      }
      ultimately show ?thesis
        using encode_problem_parallel_complete_vi_c[of _ _ "?t' - 1", OF assms(1, 2)]
        by blast
    next
      case False
      {
        {
          have "¬ index ?vs v < length ?vs"
            using False index_less_size_conv
            by auto
          hence "?v  ?V"
            by fastforce
        }
        then have "¬?𝒜π ?v"
          using v_notin_Op
          unfolding valuation_for_plan_def override_on_def empty_valuation_def Let_def
            variables_of_def operators_of_def
          by presburger
      }
      moreover {
        have "0 < ?t'"
          using trace_parallel_plan_strips_not_nil
          by blast
        then have "?t' - 1 < ?t'"
          by simp
      }
      moreover have  "¬(( ! (?t' - 1)) v = Some True)"
        using trace_parallel_plan_strips_none_if[of _ _ "?t' - 1" v, OF _ assms(2) calculation(2)]
          assms(1) False
        by simp
      ultimately show ?thesis
        using encode_problem_parallel_complete_vi_c[of _ _ "?t' - 1", OF assms(1, 2)]
        by blast
    qed
qed


text ‹ Let now termτ  trace_parallel_plan_strips I π be the trace of the plan termπ, termt  length π, and
termt'  length τ.

Any model of the SATPlan encoding term𝒜 must satisfy the following properties:
\footnote{Cf. \cite[Theorem 3.1, p. 1044]{DBLP:journals/ai/RintanenHN06} for the construction
of term𝒜.}

  \begin{enumerate}
    \item for all termk and for all termop with termk < t' - 1

      @{text[display, indent=4] "𝒜 (Operator k (index (operators_of Π) op)) = op ∈ set (π ! k)"}
    \item for all terml and for all termop with terml  t' - 1 and
      terml < length π we require

      @{text[display, indent=4] "𝒜 (Operator l (index (operators_of Π) op))"}
    \item for all termv and for all termk with termk < t' we require

      @{text[display, indent=4] "𝒜 (State k (index (variables_of Π) v)) ⟶ ((τ ! k) v = Some True)"}
    \item and finally for all termv and for all terml with terml  t' and terml < t + 1 we require

      @{text[display, indent=4] "𝒜 (State l (index (variables_of Π) v))
        = 𝒜 (State (t' - 1) (index (variables_of Π) v))"}
  \end{enumerate}

Condition ``1.'' states that the model must reflect operator activation for all operators in the
parallel operator lists termπ ! k of the plan termπ for each time step termk < t' - 1 s.t. there is a
successor state in the trace. Moreover ``3.''
requires that the model is consistent with the states reached during plan execution (i.e. the
elements termτ ! k for termk < t' of the trace termτ). Meaning that
term𝒜 (State k (index (strips_problem.variables_of Π) v)) for the SAT plan variable of
every state variable termv at time point termk if and only if term(τ ! k) v = Some True›
for the corresponding state termτ ! k at time termk (and
term¬𝒜 (State k (index (strips_problem.variables_of Π) v)) otherwise).

The second respectively fourth condition cover early plan termination by negating operator
activation and propagating the last reached state. Note that in the state propagation constraint,
the index is incremented by one compared to the similar constraint for operators, since operator
activations are always followed by at least one successor state.
Hence the last state in the trace has index
term‹length (trace_parallel_plan_strips ((Π::'variable strips_problem)I) π) - 1 and the remaining states
take up the indexes to term‹length π + 1.

% TODO Comments on how the partial encoding modeling follows from the construction (lemmas ...). ›

value  "stop" (* Tell document preparation to stop collecting for the last tag *)

― ‹ To show completeness—i.e. every valid parallel plan π› corresponds to a model
for the SATPlan encoding Φ Π (length π)›—, we simply split the
conjunction defined by the encoding into partial encodings and show that the model satisfies each
of them. ›
theorem
  encode_problem_parallel_complete:
  assumes "is_valid_problem_strips Π"
    and "is_parallel_solution_for_problem Π π"
  shows "valuation_for_plan Π π  Φ Π (length π)"
proof -
  let ?t = "length π"
    and ?I = "(Π)I"
    and ?G = "(Π)G"
    and ?𝒜 = "valuation_for_plan Π π"
  have nb: "?G m execute_parallel_plan ?I π"
    using assms(2)
    unfolding is_parallel_solution_for_problem_def
    by force
  have "?𝒜  ΦI Π"
    using encode_problem_parallel_complete_i[OF assms(1) nb]
      encode_problem_parallel_complete_vi_c[OF assms(1, 2)]
    by presburger
  moreover have "?𝒜  (ΦG Π) ?t"
    using encode_problem_parallel_complete_ii[OF assms(1) nb]
      encode_problem_parallel_complete_vi_c[OF assms(1, 2)]
      encode_problem_parallel_complete_vi_f[OF assms(1, 2)]
    by presburger
  moreover have "?𝒜  encode_operators Π ?t"
    using encode_problem_parallel_complete_iii[OF assms(1) nb]
      encode_problem_parallel_complete_vi_a[OF assms(2)]
      encode_problem_parallel_complete_vi_b[OF assms(2)]
      encode_problem_parallel_complete_vi_c[OF assms(1, 2)]
    by presburger
  moreover have "?𝒜  encode_all_frame_axioms Π ?t"
    using encode_problem_parallel_complete_iv[OF assms(1, 2)]
      encode_problem_parallel_complete_vi_a[OF assms(2)]
      encode_problem_parallel_complete_vi_c[OF assms(1, 2)]
      encode_problem_parallel_complete_vi_f[OF assms(1, 2)]
    by presburger
  ultimately show ?thesis
    unfolding encode_problem_def SAT_Plan_Base.encode_problem_def
      encode_initial_state_def encode_goal_state_def
    by auto
qed

end

Theory SAT_Plan_Extensions

(*
  Author: Mohammad Abdulaziz, Fred Kurz
*)
theory SAT_Plan_Extensions
  imports SAT_Plan_Base
begin
section "Serializable SATPlan Encodings"

text ‹ A SATPlan encoding with exclusion of operator interference (see definition
\ref{def:sat-plan-encoding-with-interference-exclusion}) can be defined by extending the basic
SATPlan encoding with clauses

  @{text[display, indent=4] "
    ¬(Atom (Operator k (index ops op1))
     ¬(Atom (Operator k (index ops op2))"}

for all pairs of distinct interfering operators termop1, termop2 for all time points
termk < t for a given estimated plan length termt. Definitions
\ref{isadef:interfering-operator-pair-exclusion-encoding} and
\ref{isadef:interfering-operator-exclusion-encoding} implement the encoding for operator pairs
resp. for all interfering operator pairs and all time points. ›

definition encode_interfering_operator_pair_exclusion
  :: "'variable strips_problem
     nat
     'variable strips_operator
     'variable strips_operator
     sat_plan_variable formula"
  where "encode_interfering_operator_pair_exclusion Π k op1 op2
     let ops = operators_of Π in
      ¬(Atom (Operator k (index ops op1)))
       ¬(Atom (Operator k (index ops op2)))"

definition encode_interfering_operator_exclusion
  :: "'variable strips_problem  nat  sat_plan_variable formula"
  where "encode_interfering_operator_exclusion Π t  let
      ops = operators_of Π
      ; interfering = filter (λ(op1, op2). index ops op1  index ops op2
         are_operators_interfering op1 op2) (List.product ops ops)
    in foldr () [encode_interfering_operator_pair_exclusion Π k op1 op2.
      (op1, op2)  interfering, k  [0..<t]] (¬)"

text ‹ A SATPlan encoding with interfering operator pair exclusion can now be defined by
simplying adding the conjunct term‹encode_interfering_operator_exclusion Π t to the basic
SATPlan encoding. ›

― ‹ NOTE This is the quadratic size encoding for the $\forall$-step semantics as defined in @{cite
‹3.2.1, p.1045› "DBLP:journals/ai/RintanenHN06"}. This encoding ensures that decoded plans are
sequentializable by simply excluding the simultaneous execution of operators with potential
interference at any timepoint. Note that this yields a $\forall$-step plan for which parallel
operator execution at any time step may be sequentialised in any order (due to non-interference). ›

definition encode_problem_with_operator_interference_exclusion
  :: "'variable strips_problem  nat  sat_plan_variable formula"
  ("Φ _ _" 52)
  where "encode_problem_with_operator_interference_exclusion Π t
     encode_initial_state Π
       (encode_operators Π t
       (encode_all_frame_axioms Π t
       (encode_interfering_operator_exclusion Π t
       (encode_goal_state Π t))))"


― ‹ Immediately proof the sublocale proposition for strips in order to gain access to definitions
and lemmas. ›


lemma cnf_of_encode_interfering_operator_pair_exclusion_is_i[simp]:
  "cnf (encode_interfering_operator_pair_exclusion Π k op1 op2) = {{
    (Operator k (index (strips_problem.operators_of Π) op1))¯
      , (Operator k (index (strips_problem.operators_of Π) op2))¯ }}"
proof -
  let ?ops = "strips_problem.operators_of Π"
  have "cnf (encode_interfering_operator_pair_exclusion Π k op1 op2)
    = cnf (¬(Atom (Operator k (index ?ops op1)))  ¬(Atom (Operator k (index ?ops op2))))"
    unfolding encode_interfering_operator_pair_exclusion_def
    by metis
  also have " = { C  D | C D.
    C  cnf (¬(Atom (Operator k (index ?ops op1))))
     D  cnf (¬(Atom (Operator k (index ?ops op2)))) }"
    by simp
  finally show ?thesis
    by auto
qed

lemma cnf_of_encode_interfering_operator_exclusion_is_ii[simp]:
  "set [encode_interfering_operator_pair_exclusion Π k op1 op2.
      (op1, op2)  filter (λ(op1, op2).
          index (strips_problem.operators_of Π) op1  index (strips_problem.operators_of Π) op2
           are_operators_interfering op1 op2)
        (List.product (strips_problem.operators_of Π) (strips_problem.operators_of Π))
        , k  [0..<t]]
    = ((op1, op2)
         { (op1, op2)  set (operators_of Π) × set (operators_of Π).
          index (strips_problem.operators_of Π) op1  index (strips_problem.operators_of Π) op2
           are_operators_interfering op1 op2 }.
      (λk. encode_interfering_operator_pair_exclusion Π k op1 op2) ` {0..<t})"
proof -
  let ?ops = "strips_problem.operators_of Π"
  let ?interfering = "filter (λ(op1, op2). index ?ops op1  index ?ops op2
     are_operators_interfering op1 op2) (List.product ?ops ?ops)"
  let ?fs = "[encode_interfering_operator_pair_exclusion Π k op1 op2.
    (op1, op2)  ?interfering, k  [0..<t]]"
  have "set ?fs = (set
    ` (λ(op1, op2). map (λk. encode_interfering_operator_pair_exclusion Π k op1 op2) [0..<t])
    ` (set (filter (λ(op1, op2). index ?ops op1  index ?ops op2  are_operators_interfering op1 op2)
      (List.product ?ops ?ops))))"
    unfolding set_concat set_map
    by blast
  ― ‹ TODO slow. ›
  also have " = ((λ(op1, op2).
      set (map (λk. encode_interfering_operator_pair_exclusion Π k op1 op2) [0..<t]))
    ` (set (filter (λ(op1, op2). index ?ops op1  index ?ops op2  are_operators_interfering op1 op2)
      (List.product ?ops ?ops))))"
    unfolding image_comp[of
        set "λ(op1, op2). map (λk. encode_interfering_operator_pair_exclusion Π k op1 op2) [0..<t]"]
      comp_apply
    by fast
  also have " = ((λ(op1, op2).
      (λk. encode_interfering_operator_pair_exclusion Π k op1 op2) ` {0..<t})
    ` (set (filter (λ(op1, op2). index ?ops op1  index ?ops op2  are_operators_interfering op1 op2)
      (List.product ?ops ?ops))))"
    unfolding set_map[of _ "[0..<t]"] atLeastLessThan_upt[of 0 t]
    by blast
  also have " = ((λ(op1, op2).
      (λk. encode_interfering_operator_pair_exclusion Π k op1 op2) ` {0..<t})
    ` (Set.filter (λ(op1, op2). index ?ops op1  index ?ops op2  are_operators_interfering op1 op2)
      (set (List.product ?ops ?ops))))"
    unfolding set_filter[of "λ(op1, op2). are_operators_interfering op1 op2" "List.product ?ops ?ops"]
    by force
  ― ‹ TODO slow.›
  finally show ?thesis
    unfolding operators_of_def set_product[of ?ops ?ops]
    by fastforce
qed

(* TODO refactor using above lemma *)
lemma cnf_of_encode_interfering_operator_exclusion_is_iii[simp]:
  (* TODO why is this necessary? *)
  fixes Π :: "'variable strips_problem"
  shows "cnf ` set [encode_interfering_operator_pair_exclusion Π k op1 op2.
      (op1, op2)  filter (λ(op1, op2).
          index (strips_problem.operators_of Π) op1  index (strips_problem.operators_of Π) op2
           are_operators_interfering op1 op2)
        (List.product (strips_problem.operators_of Π) (strips_problem.operators_of Π))
      , k  [0..<t]]
    = ((op1, op2)
         { (op1, op2)  set (strips_problem.operators_of Π) × set (strips_problem.operators_of Π).
          index (strips_problem.operators_of Π) op1  index (strips_problem.operators_of Π) op2
           are_operators_interfering op1 op2 }.
      {{{ (Operator k (index (strips_problem.operators_of Π) op1))¯
        , (Operator k (index (strips_problem.operators_of Π) op2))¯ }} | k. k  {0..<t}})"
proof -
  let ?ops = "strips_problem.operators_of Π"
  let ?interfering = "filter (λ(op1, op2). index ?ops op1  index ?ops op2
     are_operators_interfering op1 op2) (List.product ?ops ?ops)"
  let ?fs = "[encode_interfering_operator_pair_exclusion Π k op1 op2.
    (op1, op2)  ?interfering, k  [0..<t]]"
  have "cnf ` set ?fs = cnf ` ((op1, op2)  { (op1, op2).
    (op1, op2)  set (operators_of Π) × set (operators_of Π)  index ?ops op1  index ?ops op2
       are_operators_interfering op1 op2 }.
    (λk. encode_interfering_operator_pair_exclusion Π k op1 op2) ` {0..<t})"
    unfolding cnf_of_encode_interfering_operator_exclusion_is_ii
    by blast
  also have " = ((op1, op2)  { (op1, op2).
    (op1, op2)  set (operators_of Π) × set (operators_of Π)  index ?ops op1  index ?ops op2
       are_operators_interfering op1 op2 }.
    (λk. cnf (encode_interfering_operator_pair_exclusion Π k op1 op2)) ` {0..<t})"
    unfolding image_Un image_comp comp_apply
    by blast
  also have " = ((op1, op2)  { (op1, op2).
    (op1, op2)  set (operators_of Π) × set (operators_of Π)  index ?ops op1  index ?ops op2
       are_operators_interfering op1 op2 }.
    (λk. {{ (Operator k (index ?ops op1))¯, (Operator k (index ?ops op2))¯ }}) ` {0..<t})"
    by simp
  also have " = ((op1, op2)  { (op1, op2).
    (op1, op2)  set (operators_of Π) × set (operators_of Π)  index ?ops op1  index ?ops op2
         are_operators_interfering op1 op2 }.
      (λk. {{ (Operator k (index ?ops op1))¯, (Operator k (index ?ops op2))¯ }})
        ` { k | k. k  {0..<t}})"
    by blast
  ― ‹ TODO slow.›
  finally show ?thesis
    unfolding operators_of_def setcompr_eq_image[of _ "λk. k  {0..<t}"]
    by force
qed

lemma cnf_of_encode_interfering_operator_exclusion_is:
  "cnf (encode_interfering_operator_exclusion Π t) = ((op1, op2)
       { (op1, op2)  set (operators_of Π) × set (operators_of Π).
        index (strips_problem.operators_of Π) op1  index (strips_problem.operators_of Π) op2
           are_operators_interfering op1 op2 }.
    {{{ (Operator k (index (strips_problem.operators_of Π) op1))¯
      , (Operator k (index (strips_problem.operators_of Π) op2))¯ }} | k. k  {0..<t}})"
proof -
  let ?ops = "strips_problem.operators_of Π"
  let ?interfering = "filter (λ(op1, op2). index ?ops op1  index ?ops op2
     are_operators_interfering op1 op2) (List.product ?ops ?ops)"
  let ?fs = "[encode_interfering_operator_pair_exclusion Π k op1 op2.
    (op1, op2)  ?interfering, k  [0..<t]]"
  have "cnf (encode_interfering_operator_exclusion Π t) = cnf (foldr () ?fs (¬))"
    unfolding encode_interfering_operator_exclusion_def
    by metis
  also have " = (cnf ` set ?fs)"
    unfolding cnf_foldr_and[of ?fs]..
  finally show ?thesis
    unfolding cnf_of_encode_interfering_operator_exclusion_is_iii[of Π t]
    by blast
qed

lemma cnf_of_encode_interfering_operator_exclusion_contains_clause_if:
  (* TODO why do we need to fix the problem type? *)
  fixes Π :: "'variable strips_problem"
  assumes "k < t"
    and "op1  set (strips_problem.operators_of Π)" and "op2  set (strips_problem.operators_of Π)"
    and "index (strips_problem.operators_of Π) op1  index (strips_problem.operators_of Π) op2"
    and "are_operators_interfering op1 op2"
  shows "{ (Operator k (index (strips_problem.operators_of Π) op1))¯
      , (Operator k (index (strips_problem.operators_of Π) op2))¯}
     cnf (encode_interfering_operator_exclusion Π t)"
proof -
  let ?ops = "strips_problem.operators_of Π"
    and X = "encode_interfering_operator_exclusion Π t"
  let ?Ops = "{ (op1, op2)  set (operators_of Π) × set (operators_of Π).
        index ?ops op1  index ?ops op2  are_operators_interfering op1 op2 }"
    and ?f = "λ(op1, op2). {{{ (Operator k (index ?ops op1))¯, (Operator k (index ?ops op2))¯ }}
      | k. k  {0..<t}}"
  let ?A = "((op1, op2)  ?Ops. ?f (op1, op2))"
  let ?B = "?A"
    and ?C = "{ (Operator k (index ?ops op1))¯, (Operator k (index ?ops op2))¯ }"
  {
    have "(op1, op2)  ?Ops"
      using assms(2, 3, 4, 5)
      unfolding operators_of_def
      by force
    moreover have "{ ?C }  ?f (op1, op2)"
      using assms(1)
      by auto
    moreover have "{ ?C }  ?A"
      using UN_iff[of ?C _ ?Ops] calculation(1, 2)
      by blast
    (* TODO slow *)
    ultimately have "X  ?A. ?C  X"
      by auto
  }
  (* TODO slow *)
  thus ?thesis
    unfolding cnf_of_encode_interfering_operator_exclusion_is
    using Union_iff[of ?C ?A]
    by auto
qed

lemma is_cnf_encode_interfering_operator_exclusion:
  (* TODO why is this necessary? *)
  fixes Π :: "'variable strips_problem"
  shows "is_cnf (encode_interfering_operator_exclusion Π t)"
proof -
  let ?ops = "strips_problem.operators_of Π"
  let ?interfering = "filter (λ(op1, op2). index ?ops op1  index ?ops op2
     are_operators_interfering op1 op2) (List.product ?ops ?ops)"
  let ?fs = "[encode_interfering_operator_pair_exclusion Π k op1 op2.
    (op1, op2)  ?interfering, k  [0..<t]]"
  let ?Fs = "((op1, op2)
         { (op1, op2)  set (operators_of Π) × set (operators_of Π). are_operators_interfering op1 op2 }.
      (λk. encode_interfering_operator_pair_exclusion Π k op1 op2) ` {0..<t})"
  {
    fix f
    assume "f  set ?fs"
    then have "f  ?Fs"
      unfolding cnf_of_encode_interfering_operator_exclusion_is_ii
      by blast
    then obtain op1 op2
      where "(op1, op2)  set (operators_of Π) × set (operators_of Π)"
      and "are_operators_interfering op1 op2"
      and "f  (λk. encode_interfering_operator_pair_exclusion Π k op1 op2) ` {0..<t}"
      by fast
    then obtain k where "f = encode_interfering_operator_pair_exclusion Π k op1 op2"
      by blast
    then have "f = ¬(Atom (Operator k (index ?ops op1)))  ¬(Atom (Operator k (index ?ops op2)))"
      unfolding encode_interfering_operator_pair_exclusion_def
      by metis
    hence "is_cnf f"
      by force
  }
  thus ?thesis
    unfolding encode_interfering_operator_exclusion_def
    using is_cnf_foldr_and_if[of ?fs]
    by meson
qed

lemma is_cnf_encode_problem_with_operator_interference_exclusion:
  assumes "is_valid_problem_strips Π"
  shows "is_cnf (Φ Π t)"
  using is_cnf_encode_problem is_cnf_encode_interfering_operator_exclusion assms
  unfolding encode_problem_with_operator_interference_exclusion_def SAT_Plan_Base.encode_problem_def
    is_cnf.simps(1)
  by blast

lemma cnf_of_encode_problem_with_operator_interference_exclusion_structure:
  shows "cnf (ΦI Π)  cnf (Φ Π t)"
    and "cnf ((ΦG Π) t)  cnf (Φ Π t)"
    and "cnf (encode_operators Π t)  cnf (Φ Π t)"
    and "cnf (encode_all_frame_axioms Π t)  cnf (Φ Π t)"
    and "cnf (encode_interfering_operator_exclusion Π t)  cnf (Φ Π t)"
  unfolding encode_problem_with_operator_interference_exclusion_def encode_problem_def SAT_Plan_Base.encode_problem_def
    encode_initial_state_def
    encode_goal_state_def
  by auto+

(* TODO remove (unused)? *)
lemma encode_problem_with_operator_interference_exclusion_has_model_then_also_partial_encodings:
  assumes "𝒜  Φ Π t"
  shows "𝒜  SAT_Plan_Base.encode_initial_state Π"
    and "𝒜  SAT_Plan_Base.encode_operators Π t"
    and "𝒜  SAT_Plan_Base.encode_all_frame_axioms Π t"
    and "𝒜  encode_interfering_operator_exclusion Π t"
    and "𝒜  SAT_Plan_Base.encode_goal_state Π t"
  using assms
  unfolding encode_problem_with_operator_interference_exclusion_def encode_problem_def SAT_Plan_Base.encode_problem_def
  by simp+



text ‹ Just as for the basic SATPlan encoding we defined local context for the SATPlan encoding
with interfering operator exclusion. We omit this here since it is basically identical to the one
shown in the basic SATPlan theory replacing only the definitions of \isaname{encode_transitions}
and \isaname{encode_problem}. The sublocale proof is shown below. It confirms that the new
encoding again a CNF as required by locale \isaname{sat_encode_strips}. ›

subsection "Soundness"


text ‹ The Proof of soundness for the SATPlan encoding with interfering operator exclusion follows
directly from the proof of soundness of the basic SATPlan encoding. By looking at the structure of
the new encoding which simply extends the basic SATPlan encoding with a conjunct, any model for
encoding with exclusion of operator interference also models the basic SATPlan encoding and the
soundness of the new encoding therefore follows from theorem
\ref{isathm:soundness-satplan-encoding}.

Moreover, since we additionally added interfering operator exclusion clauses at every timestep, the
decoded parallel plan cannot contain any interfering operators in any parallel operator (making it
serializable). ›

― ‹ NOTE We use the subseq› formulation in the fourth assumption to be able to instantiate the
induction hypothesis on the subseq ops› given the induction premise
op # ops ∈ set (subseqs (Φ¯ Π 𝒜 t ! k))›. We do not use subsets in the
assumption since we would otherwise lose the distinctness property which can be infered from
ops ∈ set (subseqs (Φ¯ Π 𝒜 t ! k))› using lemma subseqs_distinctD›. ›
lemma encode_problem_serializable_sound_i:
  assumes "is_valid_problem_strips Π"
    and "𝒜  Φ Π t"
    and "k < t"
    and "ops  set (subseqs ((Φ¯ Π 𝒜 t) ! k))"
  shows "are_all_operators_non_interfering ops"
proof -
  let ?ops = "strips_problem.operators_of Π"
    and  = "Φ¯ Π 𝒜 t"
    and X = "encode_interfering_operator_exclusion Π t"
  let k = "(Φ¯ Π 𝒜 t) ! k"
  (* TODO refactor *)
  {
    fix C
    assume C_in: "C  cnf X"
    have "cnf_semantics 𝒜 (cnf X)"
      using cnf_semantics_monotonous_in_cnf_subsets_if[OF assms(2)
        is_cnf_encode_problem_with_operator_interference_exclusion[OF assms(1)]
        cnf_of_encode_problem_with_operator_interference_exclusion_structure(5)].
    hence "clause_semantics 𝒜 C"
      unfolding cnf_semantics_def
      using C_in
      by fast
  } note nb1 = this
  {
    fix op1 op2
    assume "op1  set k" and "op2  set k"
      and index_op1_is_not_index_op2: "index ?ops op1  index ?ops op2"
    moreover have op1_in: "op1  set ?ops" and 𝒜_models_op1:"𝒜 (Operator k (index ?ops op1))"
      and op2_in: "op2  set ?ops" and 𝒜_models_op2: "𝒜 (Operator k (index ?ops op2))"
      using decode_plan_step_element_then[OF assms(3)] calculation
      unfolding decode_plan_def
      by blast+
    moreover {
      let ?C = "{ (Operator k (index ?ops op1))¯, (Operator k (index ?ops op2))¯ }"
      assume "are_operators_interfering op1 op2"
      moreover have "?C  cnf X"
        using cnf_of_encode_interfering_operator_exclusion_contains_clause_if[OF
            assms(3) op1_in op2_in index_op1_is_not_index_op2] calculation
        by blast
      moreover have "¬clause_semantics 𝒜 ?C"
        using 𝒜_models_op1 𝒜_models_op2
        unfolding clause_semantics_def
        by auto
      ultimately have False
        using nb1
        by blast
    }
    ultimately have "¬are_operators_interfering op1 op2"
      by blast
  } note nb3 = this
  show ?thesis
    using assms
    proof (induction ops)
      case (Cons op1 ops)
      have "are_all_operators_non_interfering ops"
        using Cons.IH[OF Cons.prems(1, 2, 3) Cons_in_subseqsD[OF Cons.prems(4)]]
        by blast
      moreover {
        fix op2
        assume op2_in_ops: "op2  set ops"
        moreover have op1_in_πk: "op1  set k" and op2_in_πk: "op2  set k"
          using element_of_subseqs_then_subset[OF Cons.prems(4)] calculation(1)
          by auto+
        moreover
        {
          have "distinct (op1 # ops)"
            using subseqs_distinctD[OF Cons.prems(4)]
              decode_plan_step_distinct[OF Cons.prems(3)]
            unfolding decode_plan_def
            by blast
          moreover have "op1  set ?ops" and "op2  set ?ops"
            using decode_plan_step_element_then(1)[OF Cons.prems(3)] op1_in_πk op2_in_πk
            unfolding decode_plan_def
            by force+
          moreover have "op1  op2"
            using op2_in_ops calculation(1)
            by fastforce
          ultimately have "index ?ops op1  index ?ops op2"
            using index_eq_index_conv
            by auto
        }
        ultimately have "¬are_operators_interfering op1 op2"
          using nb3
          by blast
      }
      ultimately show ?case
        using list_all_iff
        by auto
    qed simp
qed

theorem encode_problem_serializable_sound:
  assumes "is_valid_problem_strips Π"
    and "𝒜  Φ Π t"
  shows "is_parallel_solution_for_problem Π (Φ¯ Π 𝒜 t)"
    and "k < length (Φ¯ Π 𝒜 t). are_all_operators_non_interfering ((Φ¯ Π 𝒜 t) ! k)"
proof -
  {
    have "𝒜  SAT_Plan_Base.encode_initial_state Π"
      and "𝒜  SAT_Plan_Base.encode_operators Π t"
      and "𝒜  SAT_Plan_Base.encode_all_frame_axioms Π t"
      and "𝒜  SAT_Plan_Base.encode_goal_state Π t"
      using assms(2)
      unfolding encode_problem_with_operator_interference_exclusion_def
      by simp+
    then have "𝒜  SAT_Plan_Base.encode_problem Π t"
      unfolding SAT_Plan_Base.encode_problem_def
      by simp
  }
  thus "is_parallel_solution_for_problem Π (Φ¯ Π 𝒜 t)"
    using encode_problem_parallel_sound assms(1, 2)
    unfolding decode_plan_def
    by blast
next
  let  = "Φ¯ Π 𝒜 t"
  {
    fix k
    assume "k < t"
    moreover have " ! k  set (subseqs ( ! k))"
      using subseqs_refl
      by blast
    ultimately have "are_all_operators_non_interfering ( ! k)"
      using encode_problem_serializable_sound_i[OF assms]
      unfolding SAT_Plan_Base.decode_plan_def decode_plan_def
      by blast
  }
  moreover have "length  = t"
    unfolding SAT_Plan_Base.decode_plan_def decode_plan_def
    by simp
  ultimately show "k < length . are_all_operators_non_interfering ( ! k)"
    by simp
qed


subsection "Completeness"


lemma encode_problem_with_operator_interference_exclusion_complete_i:
  assumes "is_valid_problem_strips Π"
    and "is_parallel_solution_for_problem Π π"
    and "k < length π. are_all_operators_non_interfering (π ! k)"
  shows "valuation_for_plan Π π  encode_interfering_operator_exclusion Π (length π)"
proof -
  let ?𝒜 = "valuation_for_plan Π π"
    and X = "encode_interfering_operator_exclusion Π (length π)"
    and ?ops = "strips_problem.operators_of Π"
    and ?t = "length π"
  let  = "trace_parallel_plan_strips ((Π)I) π"
  let ?Ops = "{ (op1, op2). (op1, op2)  set (operators_of Π) × set (operators_of Π)
     index ?ops op1  index ?ops op2
     are_operators_interfering op1 op2 }"
    and ?f = "λ(op1, op2). {{{ (Operator k (index ?ops op1))¯, (Operator k (index ?ops op2))¯ }}
      | k. k  {0..<length π} }"
  let ?A = "(?f ` ?Ops)"
  let ?B = "?A"
  have nb1: "ops  set π. op  set ops. op  set (operators_of Π)"
    using is_parallel_solution_for_problem_operator_set[OF assms(2)]
    unfolding operators_of_def
    by blast
  (* TODO refactor (characterization of 𝒜) *)
  {
    fix k op
    assume "k < length π" and "op  set (π ! k)"
    hence "lit_semantics ?𝒜 ((Operator k (index ?ops op))+) = (k < length  - 1)"
      using encode_problem_parallel_complete_vi_a[OF assms(2)]
        encode_problem_parallel_complete_vi_b[OF assms(2)] initial_of_def
      by(cases "k < length  - 1"; simp)
  } note nb2 = this
  {
    fix k op1 op2
    assume "k < length π"
      and "op1  set (π ! k)"
      and "index ?ops op1  index ?ops op2"
      and "are_operators_interfering op1 op2"
    moreover have "are_all_operators_non_interfering (π ! k)"
      using assms(3) calculation(1)
      by blast
    moreover have "op1  op2"
      using calculation(3)
      by blast
    ultimately have "op2  set (π ! k)"
      using are_all_operators_non_interfering_set_contains_no_distinct_interfering_operator_pairs
        assms(3)
      by blast
  } note nb3 = this
  {
    fix C
    assume "C  cnf X"
    then have "C  ?B"
      using cnf_of_encode_interfering_operator_exclusion_is[of Π "length π"]
      by argo
    then obtain C' where "C'  ?A" and C_in: "C  C'"
      using Union_iff[of C ?A]
      by meson
    then obtain op1 op2 where "(op1, op2)  set (operators_of Π) × set (operators_of Π)"
      and index_op1_is_not_index_op2: "index ?ops op1  index ?ops op2"
      and are_operators_interfering_op1_op2: "are_operators_interfering op1 op2"
      and C'_in: "C'  {{{(Operator k (index ?ops op1))¯, (Operator k (index ?ops op2))¯}}
        | k. k  {0..<length π}}"
      using UN_iff[of C' ?f ?Ops]
      by blast
    then obtain k where "k  {0..<length π}"
      and C_is: "C = { (Operator k (index ?ops op1))¯, (Operator k (index ?ops op2))¯ }"
      using C_in C'_in
      by blast
    then have k_lt_length_π: "k < length π"
      by simp
    consider (A) "op1  set (π ! k)"
     | (B) "op2  set (π ! k)"
     | (C) "¬op1  set (π ! k)  ¬op2  set (π ! k)"
      by linarith
    hence "clause_semantics ?𝒜 C"
      proof (cases)
        case A
        moreover have "op2  set (π ! k)"
          using nb3 k_lt_length_π calculation index_op1_is_not_index_op2 are_operators_interfering_op1_op2
          by blast
        moreover have "¬?𝒜 (Operator k (index ?ops op2))"
          using encode_problem_parallel_complete_vi_d[OF assms(2) k_lt_length_π]
            calculation(2)
          by blast
        ultimately show ?thesis
          using C_is
          unfolding clause_semantics_def
          by force
      next
        case B
        moreover have "op1  set (π ! k)"
          using nb3 k_lt_length_π calculation index_op1_is_not_index_op2 are_operators_interfering_op1_op2
          by blast
        moreover have "¬?𝒜 (Operator k (index ?ops op1))"
          using encode_problem_parallel_complete_vi_d[OF assms(2) k_lt_length_π]
            calculation(2)
          by blast
        ultimately show ?thesis
          using C_is
          unfolding clause_semantics_def
          by force
      next
        case C
        then show ?thesis
          proof (rule disjE)
            assume "op1  set (π ! k)"
            then have "¬?𝒜 (Operator k (index ?ops op1))"
              using encode_problem_parallel_complete_vi_d[OF assms(2) k_lt_length_π]
              by blast
            thus "clause_semantics (valuation_for_plan Π π) C"
              using C_is
              unfolding clause_semantics_def
              by force
          next
            assume "op2  set (π ! k)"
            then have "¬?𝒜 (Operator k (index ?ops op2))"
              using encode_problem_parallel_complete_vi_d[OF assms(2) k_lt_length_π]
              by blast
            thus "clause_semantics (valuation_for_plan Π π) C"
              using C_is
              unfolding clause_semantics_def
              by force
          qed
      qed
  }
  then have "cnf_semantics ?𝒜 (cnf X)"
    unfolding cnf_semantics_def..
  thus ?thesis
    using cnf_semantics[OF is_nnf_cnf[OF is_cnf_encode_interfering_operator_exclusion]]
    by fast
qed

text ‹ Similar to the soundness proof, we may reuse the previously established
facts about the valuation for the completeness proof of the basic SATPlan encoding
(\ref{isathm:completeness-satplan-encoding}).
To make it clearer why this is true we have a look at the form of the clauses for interfering operator
pairs termop1 and termop2 at the same time index termk which have the form shown below:
  @{text[display, indent=4] "{ (Operator k (index ops op1))¯, (Operator k (index ops op2))¯ }"}
where termops  strips_problem.operators_of Π.
Now, consider an operator termop1 that is contained in the termk-th plan step termπ ! k
(symmetrically for termop2). Since termπ is a serializable solution, there can be no
interference between termop1 and termop2 at time termk. Hence termop2 cannot be in termπ ! k
This entails that for term𝒜  valuation_for_plan Π π it holds that
  @{text[display, indent=4] "𝒜 ⊨ ¬ Atom (Operator k (index ops op2))"}
and term𝒜 therefore models the clause.

Furthermore, if neither is present, than term𝒜 will evaluate both atoms to false and the clause
therefore evaluates to true as well.

It follows from this that each clause in the extension of the SATPlan encoding evaluates to true
for term𝒜. The other parts of the encoding evaluate to true as per the completeness of the
basic SATPlan encoding (theorem \ref{isathm:completeness-satplan-encoding}).›

theorem encode_problem_serializable_complete:
  assumes "is_valid_problem_strips Π"
    and "is_parallel_solution_for_problem Π π"
    and "k < length π. are_all_operators_non_interfering (π ! k)"
  shows "valuation_for_plan Π π  Φ Π (length π)"
proof -
  let ?𝒜 = "valuation_for_plan Π π"
    and X = "encode_interfering_operator_exclusion Π (length π)"
  have "?𝒜  SAT_Plan_Base.encode_problem Π (length π)"
    using assms(1, 2) encode_problem_parallel_complete
    by auto
  moreover have "?𝒜  X"
    using encode_problem_with_operator_interference_exclusion_complete_i[OF assms].
  ultimately show ?thesis
    unfolding encode_problem_with_operator_interference_exclusion_def encode_problem_def
      SAT_Plan_Base.encode_problem_def
    by force
qed

value  "stop" (* Tell document preparation to stop collecting for the last tag *)

(* TODO rename encode_problem_with_operator_interference_exclusion_decoded_plan_is_serializable_i *)
lemma encode_problem_forall_step_decoded_plan_is_serializable_i:
  assumes "is_valid_problem_strips Π"
    and "𝒜  Φ Π t"
  shows "(Π)G m execute_serial_plan ((Π)I) (concat (Φ¯ Π 𝒜 t))"
proof -
  let ?G = "(Π)G"
    and ?I = "(Π)I"
    and  = "Φ¯ Π 𝒜 t"
  let ?π' = "concat (Φ¯ Π 𝒜 t)"
    and  = "trace_parallel_plan_strips ?I "
    and  = "map (decode_state_at Π 𝒜) [0..<Suc (length )]"
  {
    fix k
    assume k_lt_length_π: "k < length "
    moreover have "𝒜  SAT_Plan_Base.encode_problem Π t"
      using assms(2)
      unfolding encode_problem_with_operator_interference_exclusion_def
        encode_problem_def SAT_Plan_Base.encode_problem_def
      by simp
    moreover have "length  = length "
      using encode_problem_parallel_correct_vii assms(1) calculation
      unfolding decode_state_at_def decode_plan_def initial_of_def
      by fast
    ultimately have "k < length  - 1" and "k < t"
      unfolding decode_plan_def SAT_Plan_Base.decode_plan_def
      by force+
  } note nb = this
  {
    have "?G m execute_parallel_plan ?I "
      using encode_problem_serializable_sound assms
      unfolding is_parallel_solution_for_problem_def decode_plan_def
        goal_of_def initial_of_def
      by blast
    hence "?G m last (trace_parallel_plan_strips ?I )"
      using execute_parallel_plan_reaches_goal_iff_goal_is_last_element_of_trace
      by fast
  }
  moreover {
    fix k
    assume k_lt_length_π: "k < length "
    moreover have "k < length  - 1" and "k < t"
      using nb calculation
      by blast+
    moreover have "are_all_operators_applicable ( ! k) ( ! k)"
      and "are_all_operator_effects_consistent ( ! k)"
      using trace_parallel_plan_strips_operator_preconditions calculation(2)
      by blast+
    moreover have "are_all_operators_non_interfering ( ! k)"
      using encode_problem_serializable_sound(2)[OF assms(1, 2)] k_lt_length_π
      by blast
    ultimately have "are_all_operators_applicable ( ! k) ( ! k)"
      and "are_all_operator_effects_consistent ( ! k)"
      and "are_all_operators_non_interfering ( ! k)"
      by blast+
  }
  ultimately show ?thesis
    using execute_parallel_plan_is_execute_sequential_plan_if assms(1)
    by metis
qed

(* TODO rename encode_problem_with_operator_interference_exclusion_decoded_plan_is_serializable_ii *)
lemma encode_problem_forall_step_decoded_plan_is_serializable_ii:
  (* TODO why is the fixed type necessary? *)
  fixes Π :: "'variable strips_problem"
  shows "list_all (λop. ListMem op (strips_problem.operators_of Π))
    (concat (Φ¯ Π 𝒜 t))"
proof -
  let  = "Φ¯ Π 𝒜 t"
  let ?π' = "concat "
  (* TODO refactor *)
  {
    have "set ?π' = (set `  (k < t. { decode_plan' Π 𝒜 k }))"
      unfolding decode_plan_def decode_plan_set_is set_concat
      by auto
    also have " = (k < t. { set (decode_plan' Π 𝒜 k) })"
      by blast
    finally have "set ?π' = (k < t. set (decode_plan' Π 𝒜 k))"
      by blast
  } note nb = this
  {
    fix op
    assume "op  set ?π'"
    then obtain k where "k < t" and "op  set (decode_plan' Π 𝒜 k)"
      using nb
      by blast
    moreover have "op  set (decode_plan Π 𝒜 t ! k)"
      using calculation
      unfolding decode_plan_def SAT_Plan_Base.decode_plan_def
      by simp
    ultimately have "op  set (operators_of Π)"
      using decode_plan_step_element_then(1)
      unfolding operators_of_def decode_plan_def
      by blast
  }
  thus ?thesis
    unfolding list_all_iff ListMem_iff operators_of_def
    by blast
qed

text ‹ Given the soundness and completeness of the SATPlan encoding with interfering operator
exclusion termΦ Π t, we can
now conclude this part with showing that for a parallel plan termπ  Φ¯ Π 𝒜 t
that was decoded from a model term𝒜 of termΦ Π t the serialized plan
termπ'  concat π is a serial solution for termΠ. To this end, we have to show that
\begin{itemize}
  \item the state reached by serial execution of termπ' subsumes termG, and
  \item all operators in termπ' are operators contained in term𝒪.
\end{itemize}
While the proof of the latter step is rather straight forward, the proof for the
former requires a bit more work. We use the previously established theorem on serial and parallel
STRIPS equivalence (theorem \ref{isathm:equivalence-parallel-serial-strips-plans}) to show the
serializability of termπ and therefore have to show that termG is subsumed by the last state
of the trace of termπ'
  @{text[display, indent=4] "G ⊆m last (trace_sequential_plan_strips I π')"}
and moreover that at every step of the parallel plan execution, the parallel operator execution
condition as well as non interference are met
  @{text[display, indent=4] "∀k < length π. are_all_operators_non_interfering (π ! k)"}.
\footnote{These propositions are shown in lemmas \texttt{encode\_problem\_forall\_step\_decoded\_plan\_is\_serializable\_ii} and
\texttt{encode\_problem\_forall\_step\_decoded\_plan\_is\_serializable\_i} which have been omitted for
brevity.}
Note that the parallel operator execution condition is implicit in the existence of the parallel
trace for termπ with
  @{text[display, indent=4] "G ⊆m last (trace_parallel_plan_strips I π)"}
warranted by the soundness of termΦ Π t. ›

(* TODO rename encode_problem_with_operator_interference_exclusion_decoded_plan_is_serializable *)
theorem serializable_encoding_decoded_plan_is_serializable:
  assumes "is_valid_problem_strips Π"
    and "𝒜  Φ Π t"
  shows "is_serial_solution_for_problem Π (concat (Φ¯ Π 𝒜 t))"
  using encode_problem_forall_step_decoded_plan_is_serializable_i[OF assms]
    encode_problem_forall_step_decoded_plan_is_serializable_ii
  unfolding is_serial_solution_for_problem_def goal_of_def
    initial_of_def decode_plan_def
  by blast

end

Theory SAT_Solve_SAS_Plus

(*
  Author: Mohammad Abdulaziz, Fred Kurz
*)
theory SAT_Solve_SAS_Plus
  imports "SAS_Plus_STRIPS" 
    "SAT_Plan_Extensions"
begin
section "SAT-Solving of SAS+ Problems"


lemma sas_plus_problem_has_serial_solution_iff_i:
  assumes "is_valid_problem_sas_plus Ψ"
    and "𝒜  Φ (φ Ψ) t"
  shows "is_serial_solution_for_problem Ψ [φO¯ Ψ op. op  concat (Φ¯ (φ Ψ) 𝒜 t)]"
proof -
  let  = "φ Ψ"
    and ?π' = "concat (Φ¯ (φ Ψ) 𝒜 t)"
  let  = "[φO¯ Ψ op. op  ?π']"
  {
    have "is_valid_problem_strips " 
      using is_valid_problem_sas_plus_then_strips_transformation_too[OF assms(1)]. 
    moreover have "STRIPS_Semantics.is_serial_solution_for_problem  ?π'"
      using calculation serializable_encoding_decoded_plan_is_serializable[OF 
          _ assms(2)] 
      unfolding decode_plan_def 
      by simp
    ultimately have "SAS_Plus_Semantics.is_serial_solution_for_problem Ψ " 
      using assms(1) serial_strips_equivalent_to_serial_sas_plus 
      by blast
  }
  thus ?thesis
    using serial_strips_equivalent_to_serial_sas_plus[OF assms(1)]
    by blast
qed

lemma sas_plus_problem_has_serial_solution_iff_ii:
  assumes "is_valid_problem_sas_plus Ψ"
    and "is_serial_solution_for_problem Ψ ψ"
    and "h = length ψ"
  shows "𝒜. (𝒜  Φ (φ Ψ) h)" 
proof -
  let  = "φ Ψ" 
    and  = "φP Ψ (embed ψ)"
  let ?𝒜 = "valuation_for_plan  " 
  let ?t = "length ψ" 
  (* TODO refactor *)
  have nb: "length ψ = length "
    unfolding SAS_Plus_STRIPS.sas_plus_parallel_plan_to_strips_parallel_plan_def 
      sasp_op_to_strips_def 
      sas_plus_parallel_plan_to_strips_parallel_plan_def
    by (induction ψ; auto)
  have "is_valid_problem_strips " 
    using assms(1) is_valid_problem_sas_plus_then_strips_transformation_too 
    by blast 
  moreover have "STRIPS_Semantics.is_parallel_solution_for_problem  " 
    using execute_serial_plan_sas_plus_is_execute_parallel_plan_sas_plus[OF assms(1,2)] 
      strips_equivalent_to_sas_plus[OF assms(1)] 
    by blast
  moreover {
    fix k
    assume "k < length " 
    moreover obtain ops' where "ops' =  ! k" 
      by simp
    moreover have "ops'  set " 
      using calculation nth_mem 
      by blast 
    moreover have " = [[φO Ψ op. op  ops]. ops  embed ψ]" 
      unfolding SAS_Plus_STRIPS.sas_plus_parallel_plan_to_strips_parallel_plan_def 
        sasp_op_to_strips_def 
        sas_plus_parallel_plan_to_strips_parallel_plan_def
      ..
    moreover obtain ops 
      where "ops' = [φO Ψ op. op  ops]"
        and "ops  set (embed ψ)" 
      using calculation(3, 4) 
      by auto
    moreover have "ops  { [op] | op. op  set ψ }" 
      using calculation(6) set_of_embed_is
      by blast 
    moreover obtain op 
      where "ops = [op]" and "op  set ψ" 
      using calculation(7)
      by blast
    ultimately have "are_all_operators_non_interfering ( ! k)" 
      by fastforce
  }
  ultimately show ?thesis 
    using encode_problem_serializable_complete nb
    by (auto simp: assms(3))
qed

text ‹ To wrap-up our documentation of the Isabelle formalization, we take a look at the central 
theorem which combines all the previous theorem to show that SAS+ problems termΨ can be solved 
using the planning as satisfiability framework.

A solution termψ for the SAS+ problem termΨ exists if and only if a model term𝒜 and a 
hypothesized plan length termt exist s.t. 
@{text[display,indent=4] "𝒜 ⊨ Φ (φ Ψ) t"} 
for the serializable SATPlan encoding of the corresponding STRIPS problem termΦ (φ Ψ) t exist. ›
theorem  sas_plus_problem_has_serial_solution_iff:
  assumes "is_valid_problem_sas_plus Ψ" 
  shows "(ψ. is_serial_solution_for_problem Ψ ψ)  (𝒜 t. 𝒜  Φ (φ Ψ) t)" 
  using sas_plus_problem_has_serial_solution_iff_i[OF assms]
    sas_plus_problem_has_serial_solution_iff_ii[OF assms] 
  by blast


section ‹Adding Noop actions to the SAS+ problem›

text ‹Here we add noop actions to the SAS+ problem to enable the SAT formula to be satisfiable if
      there are plans that are shorter than the given horizons.›

definition "empty_sasp_action  SAS_Plus_Representation.sas_plus_operator.precondition_of = [],
                                SAS_Plus_Representation.sas_plus_operator.effect_of = []"

lemma sasp_exec_noops: "execute_serial_plan_sas_plus s (replicate n empty_sasp_action) = s"
  by (induction n arbitrary: )
     (auto simp: empty_sasp_action_def STRIPS_Representation.is_operator_applicable_in_def
                 execute_operator_def)

definition
  "prob_with_noop Π 
     SAS_Plus_Representation.sas_plus_problem.variables_of = SAS_Plus_Representation.sas_plus_problem.variables_of Π,
      SAS_Plus_Representation.sas_plus_problem.operators_of = empty_sasp_action # SAS_Plus_Representation.sas_plus_problem.operators_of Π, 
      SAS_Plus_Representation.sas_plus_problem.initial_of = SAS_Plus_Representation.sas_plus_problem.initial_of Π,
      SAS_Plus_Representation.sas_plus_problem.goal_of = SAS_Plus_Representation.sas_plus_problem.goal_of Π,
      SAS_Plus_Representation.sas_plus_problem.range_of = SAS_Plus_Representation.sas_plus_problem.range_of Π"

lemma sasp_noops_in_noop_problem: "set (replicate n empty_sasp_action)  set (SAS_Plus_Representation.sas_plus_problem.operators_of (prob_with_noop Π))"
  by (induction n) (auto simp: prob_with_noop_def)

lemma noops_complete:
  "SAS_Plus_Semantics.is_serial_solution_for_problem Ψ π 
     SAS_Plus_Semantics.is_serial_solution_for_problem (prob_with_noop Ψ) ((replicate n empty_sasp_action) @ π)"
  by(induction n)
    (auto simp: SAS_Plus_Semantics.is_serial_solution_for_problem_def insert list.pred_set
                    sasp_exec_noops prob_with_noop_def Let_def empty_sasp_action_def elem)

definition "rem_noops  filter (λop. op  empty_sasp_action)"

lemma sasp_filter_empty_action:
  "execute_serial_plan_sas_plus s (rem_noops πs) = execute_serial_plan_sas_plus s πs"
  by (induction πs arbitrary: s)
     (auto simp: empty_sasp_action_def rem_noops_def)

lemma noops_sound:
  "SAS_Plus_Semantics.is_serial_solution_for_problem (prob_with_noop Ψ) πs 
     SAS_Plus_Semantics.is_serial_solution_for_problem Ψ (rem_noops πs)"
  by(induction πs)
    (fastforce simp: SAS_Plus_Semantics.is_serial_solution_for_problem_def insert list.pred_set
                     prob_with_noop_def ListMem_iff rem_noops_def
                     sasp_filter_empty_action[unfolded empty_sasp_action_def rem_noops_def]
                     empty_sasp_action_def)+

lemma noops_valid: "is_valid_problem_sas_plus Ψ  is_valid_problem_sas_plus (prob_with_noop Ψ)"
  by (auto simp: is_valid_problem_sas_plus_def prob_with_noop_def Let_def
                 empty_sasp_action_def is_valid_operator_sas_plus_def list.pred_set)

lemma sas_plus_problem_has_serial_solution_iff_i':
  assumes "is_valid_problem_sas_plus Ψ"
    and "𝒜  Φ (φ (prob_with_noop Ψ)) t"
  shows "SAS_Plus_Semantics.is_serial_solution_for_problem Ψ 
           (rem_noops
                   (map (λop. φO¯ (prob_with_noop Ψ) op)
                        (concat (Φ¯ (φ (prob_with_noop Ψ)) 𝒜 t))))"
  using assms noops_valid 
  by(force intro!: noops_sound sas_plus_problem_has_serial_solution_iff_i)

lemma sas_plus_problem_has_serial_solution_iff_ii':
  assumes "is_valid_problem_sas_plus Ψ"
    and "SAS_Plus_Semantics.is_serial_solution_for_problem Ψ ψ"
    and "length ψ  h"
  shows "𝒜. (𝒜  Φ (φ (prob_with_noop Ψ)) h)" 
  using assms
  by(fastforce 
       intro!: assms noops_valid noops_complete
               sas_plus_problem_has_serial_solution_iff_ii
                 [where ψ = "(replicate (h - length ψ) empty_sasp_action) @ ψ"] )
end


Theory AST_SAS_Plus_Equivalence

(*
  Author: Mohammad Abdulaziz
*)
theory AST_SAS_Plus_Equivalence
  imports "AI_Planning_Languages_Semantics.SASP_Semantics" "SAS_Plus_Semantics" "List-Index.List_Index" 
begin                                                               

section ‹Proving Equivalence of SAS+ representation and Fast-Downward's Multi-Valued Problem
         Representation›

subsection ‹Translating Fast-Downward's represnetation to SAS+›


type_synonym nat_sas_plus_problem = "(nat, nat) sas_plus_problem" 
type_synonym nat_sas_plus_operator = "(nat, nat) sas_plus_operator" 
type_synonym nat_sas_plus_plan = "(nat, nat) sas_plus_plan" 
type_synonym nat_sas_plus_state = "(nat, nat) state" 


definition is_standard_effect :: "ast_effect  bool"
  where "is_standard_effect  λ(pre, _, _, _). pre = []" 

definition is_standard_operator :: "ast_operator  bool"
  where "is_standard_operator  λ(_, _, effects, _). list_all is_standard_effect effects"

fun rem_effect_implicit_pres:: "ast_effect  ast_effect" where
  "rem_effect_implicit_pres (preconds, v, implicit_pre, eff) = (preconds, v, None, eff)" 

fun rem_implicit_pres :: "ast_operator  ast_operator" where
  "rem_implicit_pres (name, preconds, effects, cost) =
     (name, (implicit_pres effects) @ preconds, map rem_effect_implicit_pres effects, cost)"

fun rem_implicit_pres_ops :: "ast_problem  ast_problem" where
  "rem_implicit_pres_ops (vars, init, goal, ops) = (vars, init, goal, map rem_implicit_pres ops)"

definition "consistent_map_lists xs1 xs2  ((x1,x2)  set xs1. (y1,y2) set xs2. x1 = y1  x1 = y2)"

lemma map_add_comm: "(x. x  dom m1  x  dom m2  m1 x = m2 x)  m1 ++ m2 = m2 ++ m1"
  by (fastforce simp add: map_add_def split: option.splits)

lemma first_map_add_submap: "(x. x  dom m1  x  dom m2  m1 x = m2 x) 
        m1 ++ m2 m x  m1 m x"
  using map_add_le_mapE map_add_comm
  by force

lemma subsuming_states_map_add:
  "(x. x  dom m1  dom m2  m1 x = m2 x) 
  m1 ++ m2 m s  (m1 m s  m2 m s)"
  by(auto simp: map_add_le_mapI intro: first_map_add_submap map_add_le_mapE)

lemma consistent_map_lists:
  "distinct (map fst (xs1 @ xs2)); x  dom (map_of xs1)  dom (map_of xs2)  
     (map_of xs1) x = (map_of xs2) x"
  apply(induction xs1)
   apply (simp_all add: consistent_map_lists_def image_def)
  using map_of_SomeD
  by fastforce

lemma subsuming_states_append: 
  "distinct (map fst (xs @ ys))  
     (map_of (xs @ ys)) m s  ((map_of ys) m s  (map_of xs) m s)"
  unfolding map_of_append
  apply(intro subsuming_states_map_add)
  apply (auto simp add: image_def)
  by (metis (mono_tags, lifting) IntI empty_iff fst_conv mem_Collect_eq)

definition consistent_pres_op where
  "consistent_pres_op op  (case op of (name, pres, effs, cost)  
                               distinct (map fst (pres @ (implicit_pres effs)))
                                consistent_map_lists pres (implicit_pres effs))"

definition consistent_pres_op' where
  "consistent_pres_op' op  (case op of (name, pres, effs, cost)  
                               consistent_map_lists pres (implicit_pres effs))"

lemma consistent_pres_op_then': "consistent_pres_op op  consistent_pres_op' op"
  by(auto simp add: consistent_pres_op'_def consistent_pres_op_def)

lemma rem_implicit_pres_ops_valid_states:
   "ast_problem.valid_states (rem_implicit_pres_ops prob) = ast_problem.valid_states prob"
  apply(cases prob)
  by(auto simp add: ast_problem.valid_states_def ast_problem.Dom_def 
                       ast_problem.numVars_def ast_problem.astDom_def
                       ast_problem.range_of_var_def ast_problem.numVals_def)

lemma rem_implicit_pres_ops_lookup_op_None:
  "ast_problem.lookup_operator (vars, init, goal, ops) name = None  
   ast_problem.lookup_operator (rem_implicit_pres_ops (vars, init, goal, ops)) name = None"
  by (induction ops) (auto simp: ast_problem.lookup_operator_def ast_problem.astδ_def)

lemma rem_implicit_pres_ops_lookup_op_Some_1:
  "ast_problem.lookup_operator (vars, init, goal, ops) name = Some (n,p,vp,e) 
   ast_problem.lookup_operator (rem_implicit_pres_ops (vars, init, goal, ops)) name =
     Some (rem_implicit_pres (n,p,vp,e))"
  by (induction ops) (fastforce simp: ast_problem.lookup_operator_def ast_problem.astδ_def)+

lemma rem_implicit_pres_ops_lookup_op_Some_1':
  "ast_problem.lookup_operator prob name = Some (n,p,vp,e) 
   ast_problem.lookup_operator (rem_implicit_pres_ops prob) name =
     Some (rem_implicit_pres (n,p,vp,e))"
  apply(cases prob)
  using rem_implicit_pres_ops_lookup_op_Some_1
  by simp

lemma implicit_pres_empty: "implicit_pres (map rem_effect_implicit_pres effs) = []"
  by (induction effs) (auto simp: implicit_pres_def)

lemma rem_implicit_pres_ops_lookup_op_Some_2:
  "ast_problem.lookup_operator (rem_implicit_pres_ops (vars, init, goal, ops)) name = Some op
      op'. ast_problem.lookup_operator (vars, init, goal, ops) name = Some op' 
               (op = rem_implicit_pres op')"
  by (induction ops) (auto simp: ast_problem.lookup_operator_def ast_problem.astδ_def implicit_pres_empty image_def)

lemma rem_implicit_pres_ops_lookup_op_Some_2':
  "ast_problem.lookup_operator (rem_implicit_pres_ops prob) name = Some (n,p,e,c)
      op'. ast_problem.lookup_operator prob name = Some op' 
               ((n,p,e,c) = rem_implicit_pres op')"
  apply(cases prob)
  using rem_implicit_pres_ops_lookup_op_Some_2
  by auto

lemma subsuming_states_def':
  "s  ast_problem.subsuming_states prob ps = (s  (ast_problem.valid_states prob)  ps m s)"
  by (auto simp add: ast_problem.subsuming_states_def)

lemma rem_implicit_pres_ops_enabled_1:
  "(op. op  set (ast_problem.astδ prob)  consistent_pres_op op);
        ast_problem.enabled prob name s 
     ast_problem.enabled (rem_implicit_pres_ops prob) name s"
  by (fastforce simp: ast_problem.enabled_def rem_implicit_pres_ops_valid_states subsuming_states_def'
                      implicit_pres_empty
                 intro!: map_add_le_mapI
                 dest: rem_implicit_pres_ops_lookup_op_Some_1'
                 split: option.splits)+

context ast_problem
begin

lemma lookup_Some_inδ: "lookup_operator π = Some op  opset astδ"
    by(auto simp: find_Some_iff in_set_conv_nth lookup_operator_def)

end

lemma rem_implicit_pres_ops_enabled_2:
  assumes "(op. op  set (ast_problem.astδ prob)  consistent_pres_op op)"
  shows "ast_problem.enabled (rem_implicit_pres_ops prob) name s  
           ast_problem.enabled prob name s"
  using assms[OF ast_problem.lookup_Some_inδ, unfolded consistent_pres_op_def]
  apply(auto simp: subsuming_states_append rem_implicit_pres_ops_valid_states subsuming_states_def'
                   ast_problem.enabled_def
             dest!: rem_implicit_pres_ops_lookup_op_Some_2'
             split: option.splits)
  using subsuming_states_map_add consistent_map_lists
  apply (metis Map.map_add_comm dom_map_of_conv_image_fst map_add_le_mapE)
  using map_add_le_mapE by blast

lemma rem_implicit_pres_ops_enabled:
  "(op. op  set (ast_problem.astδ prob)  consistent_pres_op op) 
        ast_problem.enabled (rem_implicit_pres_ops prob) name s = ast_problem.enabled prob name s"
  using rem_implicit_pres_ops_enabled_1 rem_implicit_pres_ops_enabled_2
  by blast

context ast_problem
begin

lemma std_eff_enabled[simp]:
  "is_standard_operator (name, pres, effs, layer)  s  valid_states  (filter (eff_enabled s) effs) = effs"
  by (induction effs) (auto simp: is_standard_operator_def is_standard_effect_def eff_enabled_def subsuming_states_def)

end

lemma is_standard_operator_rem_implicit: "is_standard_operator (n,p,vp,v)  
         is_standard_operator (rem_implicit_pres (n,p,vp,v))"
  by (induction vp) (auto simp: is_standard_operator_def is_standard_effect_def)

lemma is_standard_operator_rem_implicit_pres_ops:
   "(op. op  set (ast_problem.astδ (a,b,c,d))  is_standard_operator op);
       op  set (ast_problem.astδ (rem_implicit_pres_ops (a,b,c,d)))
        is_standard_operator op"
  by (induction d) (fastforce simp add: ast_problem.astδ_def image_def dest!: is_standard_operator_rem_implicit)+

lemma is_standard_operator_rem_implicit_pres_ops':
   "op  set (ast_problem.astδ (rem_implicit_pres_ops prob));
    (op. op  set (ast_problem.astδ prob)  is_standard_operator op)
       is_standard_operator op"
  apply(cases prob)
  using is_standard_operator_rem_implicit_pres_ops
  by blast

lemma in_rem_implicit_pres_δ:
  "op  set (ast_problem.astδ prob) 
     rem_implicit_pres op  set (ast_problem.astδ (rem_implicit_pres_ops prob))"
  by(auto simp add: ast_problem.astδ_def)

lemma rem_implicit_pres_ops_execute:
  assumes
    "(op. op  set (ast_problem.astδ prob)  is_standard_operator op)" and
    "s  ast_problem.valid_states prob"
  shows "ast_problem.execute (rem_implicit_pres_ops prob) name s = ast_problem.execute prob name s"
proof-
  have "(n,ps,es,c)  set (ast_problem.astδ prob) 
       (filter (ast_problem.eff_enabled prob s) es) = es" for n ps es c
    using assms(2)
    by (auto simp add: ast_problem.std_eff_enabled dest!: assms(1))
  moreover have "(n,ps,es,c)  set (ast_problem.astδ prob) 
       (filter (ast_problem.eff_enabled (rem_implicit_pres_ops prob) s) (map rem_effect_implicit_pres es))
            = map rem_effect_implicit_pres es" for n ps es c
    using assms
    by (fastforce simp add: ast_problem.std_eff_enabled rem_implicit_pres_ops_valid_states
        dest!: is_standard_operator_rem_implicit_pres_ops'
        dest: in_rem_implicit_pres_δ)
  moreover have "map_of (map ((λ(_,x,_,v). (x,v)) o rem_effect_implicit_pres) effs) =
                    map_of (map (λ(_,x,_,v). (x,v)) effs)" for effs
    by (induction effs) auto
  ultimately show ?thesis
    by(auto simp add: ast_problem.execute_def rem_implicit_pres_ops_lookup_op_Some_1'
        split: option.splits
        dest: rem_implicit_pres_ops_lookup_op_Some_2' ast_problem.lookup_Some_inδ)
qed

lemma rem_implicit_pres_ops_path_to:
   "wf_ast_problem prob 
       (op. op  set (ast_problem.astδ prob)  consistent_pres_op op) 
       (op. op  set (ast_problem.astδ prob)  is_standard_operator op) 
       s  ast_problem.valid_states prob 
       ast_problem.path_to (rem_implicit_pres_ops prob) s πs s' = ast_problem.path_to prob s πs s'"
  by (induction πs arbitrary: s)
     (auto simp: rem_implicit_pres_ops_execute rem_implicit_pres_ops_enabled
                 ast_problem.path_to.simps wf_ast_problem.execute_preserves_valid)

lemma rem_implicit_pres_ops_astG[simp]: "ast_problem.astG (rem_implicit_pres_ops prob) =
           ast_problem.astG prob"
  apply(cases prob)
  by (auto simp add: ast_problem.astG_def)

lemma rem_implicit_pres_ops_goal[simp]: "ast_problem.G (rem_implicit_pres_ops prob) = ast_problem.G prob"
  apply(cases prob)
  using rem_implicit_pres_ops_valid_states
  by (auto simp add: ast_problem.G_def ast_problem.astG_def subsuming_states_def')

lemma rem_implicit_pres_ops_astI[simp]:
   "ast_problem.astI (rem_implicit_pres_ops prob) = ast_problem.astI prob"
  apply(cases prob)
  by (auto simp add: ast_problem.I_def ast_problem.astI_def subsuming_states_def')

lemma rem_implicit_pres_ops_init[simp]: "ast_problem.I (rem_implicit_pres_ops prob) = ast_problem.I prob"
  apply(cases prob)
  by (auto simp add: ast_problem.I_def ast_problem.astI_def)

lemma rem_implicit_pres_ops_valid_plan:
  assumes "wf_ast_problem prob"
       "(op. op  set (ast_problem.astδ prob)  consistent_pres_op op)"
       "(op. op  set (ast_problem.astδ prob)  is_standard_operator op)"
  shows "ast_problem.valid_plan (rem_implicit_pres_ops prob) πs = ast_problem.valid_plan prob πs"
  using wf_ast_problem.I_valid[OF assms(1)] rem_implicit_pres_ops_path_to[OF assms]
  by (simp add: ast_problem.valid_plan_def rem_implicit_pres_ops_goal rem_implicit_pres_ops_init)

lemma rem_implicit_pres_ops_numVars[simp]:
  "ast_problem.numVars (rem_implicit_pres_ops prob) = ast_problem.numVars prob"
  by (cases prob) (simp add: ast_problem.numVars_def ast_problem.astDom_def)

lemma rem_implicit_pres_ops_numVals[simp]:
  "ast_problem.numVals (rem_implicit_pres_ops prob) x = ast_problem.numVals prob x"
  by (cases prob) (simp add: ast_problem.numVals_def ast_problem.astDom_def)

lemma in_implicit_pres: 
  "(x, a)  set (implicit_pres effs)  (epres v vp. (epres,x,vp,v) set effs  vp = Some a)"
  by (induction effs) (fastforce simp: implicit_pres_def image_def split: if_splits)+

lemma pair4_eqD: "(a1,a2,a3,a4) = (b1,b2,b3,b4)  a3 = b3"
  by simp  

lemma rem_implicit_pres_ops_wf_partial_state:
   "ast_problem.wf_partial_state (rem_implicit_pres_ops prob) s =
         ast_problem.wf_partial_state prob s"
  by (auto simp: ast_problem.wf_partial_state_def)

lemma rem_implicit_pres_wf_operator:
  assumes "consistent_pres_op op"
    "ast_problem.wf_operator prob op"
  shows
    "ast_problem.wf_operator (rem_implicit_pres_ops prob) (rem_implicit_pres op)"
proof-
  obtain name pres effs cost where op: "op = (name, pres, effs, cost)"
    by (cases op)
  hence asses: "consistent_pres_op (name, pres, effs, cost)"
    "ast_problem.wf_operator prob (name, pres, effs, cost)"
    using assms
    by auto
  hence "distinct (map fst ((implicit_pres effs) @ pres))"
    by (simp only: consistent_pres_op_def) auto
  moreover have "x < ast_problem.numVars (rem_implicit_pres_ops prob)"
    "v < ast_problem.numVals (rem_implicit_pres_ops prob) x"
    if "(x,v)  set ((implicit_pres effs) @ pres)" for x v
    using that asses
    by (auto dest!: in_implicit_pres simp: ast_problem.wf_partial_state_def ast_problem.wf_operator_def)
  ultimately have "ast_problem.wf_partial_state (rem_implicit_pres_ops prob) ((implicit_pres effs) @ pres)"
    by (auto simp only: ast_problem.wf_partial_state_def)
  moreover have "(map (λ(_, v, _, _). v) effs) = 
                        (map (λ(_, v, _, _). v) (map rem_effect_implicit_pres effs))"
    by auto
  hence "distinct (map (λ(_, v, _, _). v) (map rem_effect_implicit_pres effs))"
    using assms(2)
    by (auto simp only: op ast_problem.wf_operator_def rem_implicit_pres.simps dest!: pair4_eqD)
  moreover have "(vp. (epres,x,vp,v)set effs)  (epres,x,None,v)set (map rem_effect_implicit_pres effs)"
    for epres x v
    by force
  ultimately show ?thesis
    using assms(2)
    by (auto simp: op ast_problem.wf_operator_def rem_implicit_pres_ops_wf_partial_state 
             split: prod.splits)      
qed

lemma rem_implicit_pres_ops_inδD: "op  set (ast_problem.astδ (rem_implicit_pres_ops prob))
         (op'. op'  set (ast_problem.astδ prob)  op = rem_implicit_pres op')"
  by (cases prob) (force simp: ast_problem.astδ_def)

lemma rem_implicit_pres_ops_well_formed:
  assumes "(op. op  set (ast_problem.astδ prob)  consistent_pres_op op)"
        "ast_problem.well_formed prob"
  shows "ast_problem.well_formed (rem_implicit_pres_ops prob)"
proof-
  have "map fst (ast_problem.astδ (rem_implicit_pres_ops prob)) = map fst (ast_problem.astδ prob)"
    by (cases prob) (auto simp: ast_problem.astδ_def)
  thus ?thesis
   using assms
   by(auto simp add: ast_problem.well_formed_def rem_implicit_pres_ops_wf_partial_state
           simp del: rem_implicit_pres.simps
           dest!: rem_implicit_pres_ops_inδD
           intro!: rem_implicit_pres_wf_operator)
qed

definition is_standard_effect'
  :: "ast_effect  bool"
  where "is_standard_effect'  λ(pre, _, vpre, _). pre = []  vpre = None" 

definition is_standard_operator'
  :: "ast_operator  bool"
  where "is_standard_operator'  λ(_, _, effects, _). list_all is_standard_effect' effects"

lemma rem_implicit_pres_is_standard_operator':
  "is_standard_operator (n,p,es,c)  is_standard_operator' (rem_implicit_pres (n,p,es,c))"
  by (induction es) (auto simp: is_standard_operator'_def is_standard_operator_def is_standard_effect_def
                                is_standard_effect'_def)

lemma rem_implicit_pres_ops_is_standard_operator':
  "(op. op  set (ast_problem.astδ (vs, I, G, ops))  is_standard_operator op) 
    πset (ast_problem.astδ (rem_implicit_pres_ops (vs, I, G, ops)))  is_standard_operator' π"
  by (cases ops) (auto simp: ast_problem.astδ_def dest!: rem_implicit_pres_is_standard_operator')

locale abs_ast_prob = wf_ast_problem + 
  assumes no_cond_effs: "πset astδ. is_standard_operator' π"

context ast_problem
begin

definition "abs_ast_variable_section = [0..<(length astDom)]"

definition abs_range_map
  :: "(nat  nat list)"
  where "abs_range_map  
        map_of (zip abs_ast_variable_section 
                    (map ((λvals. [0..<length vals]) o snd o snd)
                         astDom))"

end

context abs_ast_prob
begin
      
lemma is_valid_vars_1: "astDom  []  abs_ast_variable_section  []"
  by(simp add: abs_ast_variable_section_def)

end

lemma upt_eq_Nil_conv'[simp]: "([] = [i..<j]) = (j = 0  j  i)"
  by(induct j)simp_all

lemma map_of_zip_map_Some: 
     "v < length xs
         (map_of (zip [0..<length xs] (map f xs)) v) = Some (f (xs ! v))"
  by (induction xs rule: rev_induct) (auto simp add: nth_append map_add_Some_iff)

lemma map_of_zip_Some:
     "v < length xs
         (map_of (zip [0..<length xs] xs) v) = Some (xs ! v)"
  by (induction xs rule: rev_induct) (auto simp add: nth_append map_add_Some_iff)

lemma in_set_zip_lengthE:
  "(x,y)  set(zip [0..<length xs] xs)  ( x < length xs; xs ! x =y   R)  R"
  by (induction xs rule: rev_induct) (auto simp add: nth_append map_add_Some_iff)

context abs_ast_prob
begin

lemma is_valid_vars_2:
  shows "list_all (λv. abs_range_map v  None) abs_ast_variable_section"
  by (auto simp add: abs_range_map_def abs_ast_variable_section_def list.pred_set)
end

context ast_problem
begin

definition abs_ast_initial_state
  :: "nat_sas_plus_state" 
  where "abs_ast_initial_state  map_of (zip [0..<length astI] astI)"

end

context abs_ast_prob
begin

lemma valid_abs_init_1: "abs_ast_initial_state v  None  v  set abs_ast_variable_section"
  by (simp add: abs_ast_variable_section_def numVars_def wf_initial(1) abs_ast_initial_state_def)

lemma abs_range_map_Some:
  shows "v  set abs_ast_variable_section 
            (abs_range_map v) = Some [0..<length (snd (snd (astDom ! v)))]"
  by (simp add: numVars_def abs_range_map_def o_def abs_ast_variable_section_def map_of_zip_map_Some)

lemma in_abs_v_sec_length: "v  set abs_ast_variable_section  v < length astDom"
  by (simp add: abs_ast_variable_section_def)

lemma [simp]: "v < length astDom  (abs_ast_initial_state v) = Some (astI ! v)"
  using wf_initial(1)[simplified numVars_def, symmetric]
  by (auto simp add: map_of_zip_Some abs_ast_initial_state_def split: prod.splits)

lemma [simp]: "v < length astDom  astI ! v < length (snd (snd (astDom ! v)))"
  using wf_initial(1)[simplified numVars_def, symmetric] wf_initial
  by (auto simp add: numVals_def abs_ast_initial_state_def
              split: prod.splits)

lemma [intro!]: "v  set abs_ast_variable_section  x < length (snd (snd (astDom ! v))) 
                 x  set (the (abs_range_map v))"
  using abs_range_map_Some
  by (auto simp add: )

lemma [intro!]: "x<length astDom  astI ! x < length (snd (snd (astDom ! x)))"
  using wf_initial[unfolded numVars_def numVals_def]
  by auto

lemma [simp]: "abs_ast_initial_state v = Some a  a < length (snd (snd (astDom ! v)))"
  by(auto simp add: abs_ast_initial_state_def
                    wf_initial(1)[unfolded numVars_def numVals_def, symmetric]
          elim!: in_set_zip_lengthE)

lemma valid_abs_init_2:
  "abs_ast_initial_state v  None  (the (abs_ast_initial_state v))  set (the (abs_range_map v))"
  using valid_abs_init_1
  by auto

end

context ast_problem
begin

definition abs_ast_goal
  :: "nat_sas_plus_state" 
  where "abs_ast_goal  map_of astG"

end

context abs_ast_prob
begin

lemma [simp]: "wf_partial_state s  (v, a)  set s  v  set abs_ast_variable_section"
  by (auto simp add: wf_partial_state_def abs_ast_variable_section_def numVars_def
           split: prod.splits)

lemma valid_abs_goal_1: "abs_ast_goal v  None  v  set abs_ast_variable_section"
  using wf_goal
  by (auto simp add: abs_ast_goal_def dest!: map_of_SomeD)

lemma in_abs_rangeI: "wf_partial_state s  (v, a)  set s  (a  set (the (abs_range_map v)))"
  by (auto simp add: abs_range_map_Some wf_partial_state_def numVals_def split: prod.splits)

lemma valid_abs_goal_2:
  "abs_ast_goal v  None  (the (abs_ast_goal v))  set (the (abs_range_map v))"
  using wf_goal 
  by (auto simp add: map_of_SomeD weak_map_of_SomeI abs_ast_goal_def intro!: in_abs_rangeI)

end

context ast_problem
begin

definition abs_ast_operator
  :: "ast_operator  nat_sas_plus_operator"
  where "abs_ast_operator  λ(name, preconditions, effects, cost). 
        precondition_of = preconditions, 
         effect_of = [(v, x). (_, v, _, x)  effects] "

end

context abs_ast_prob
begin

lemma abs_rangeI: "wf_partial_state s  (v, a)  set s  (abs_range_map v  None)"
  by (auto simp add: wf_partial_state_def abs_range_map_def abs_ast_variable_section_def list.pred_set
                     numVars_def
           split: prod.splits)

lemma abs_valid_operator_1[intro!]:
  "wf_operator op  list_all (λ(v, a). ListMem v abs_ast_variable_section)
   (precondition_of (abs_ast_operator op))"
  by (cases op; auto simp add: abs_ast_operator_def wf_operator_def list.pred_set ListMem_iff)

lemma wf_operator_preD: "wf_operator (name, pres, effs, cost)  wf_partial_state pres"
  by (simp add: wf_operator_def)

lemma abs_valid_operator_2[intro!]:
  "wf_operator op  
    list_all (λ(v, a). (y. abs_range_map v = Some y)  ListMem a (the (abs_range_map v)))
             (precondition_of (abs_ast_operator op))"
  by(cases op, 
     auto dest!: wf_operator_preD simp: list.pred_set ListMem_iff abs_ast_operator_def
          intro!: abs_rangeI[simplified not_None_eq] in_abs_rangeI)

lemma wf_operator_effE: "wf_operator (name, pres, effs, cost) 
          (distinct (map (λ(_, v, _, _). v) effs);
            epres x vp v. (epres,x,vp,v)set effs  wf_partial_state epres; 
            epres x vp v.(epres,x,vp,v)set effs  x < numVars;
            epres x vp v. (epres,x,vp,v)set effs  v < numVals x;
            epres x vp v. (epres,x,vp,v)set effs  
                    case vp of None  True | Some v  v<numVals x
              P)
            P"
  unfolding wf_operator_def
  by (auto split: prod.splits)
  
lemma abs_valid_operator_3':
  "wf_operator (name, pre, eff, cost) 
     list_all (λ(v, a). ListMem v abs_ast_variable_section) (map (λ(_, v, _, a). (v, a)) eff)"
  by (fastforce simp add: list.pred_set ListMem_iff abs_ast_variable_section_def image_def numVars_def
                elim!: wf_operator_effE split: prod.splits)

lemma abs_valid_operator_3[intro!]:
  "wf_operator op 
     list_all (λ(v, a). ListMem v abs_ast_variable_section) (effect_of (abs_ast_operator op))"
  by (cases op, simp add: abs_ast_operator_def abs_valid_operator_3')

lemma wf_abs_eff: "wf_operator (name, pre, eff, cost)  wf_partial_state (map (λ(_, v, _, a). (v, a)) eff)"
  by (elim wf_operator_effE, induction eff)
     (fastforce simp: wf_partial_state_def image_def o_def split: prod.split_asm)+
  
lemma abs_valid_operator_4':
  "wf_operator (name, pre, eff, cost) 
     list_all (λ(v, a). (abs_range_map v  None)  ListMem a (the (abs_range_map v))) (map (λ(_, v, _, a). (v, a)) eff)"
  apply(subst list.pred_set ListMem_iff)+
  apply(drule wf_abs_eff)
  by (metis (mono_tags, lifting) abs_rangeI case_prodI2 in_abs_rangeI)

lemma abs_valid_operator_4[intro!]:
  "wf_operator op 
     list_all (λ(v, a). (y. abs_range_map v = Some y)  ListMem a (the (abs_range_map v)))
              (effect_of (abs_ast_operator op))"
  using abs_valid_operator_4'
  by (cases op, simp add: abs_ast_operator_def)

lemma consistent_list_set: "wf_partial_state s 
   list_all (λ(v, a). list_all (λ(v', a'). v  v'  a = a') s) s"
  by (auto simp add: list.pred_set wf_partial_state_def eq_key_imp_eq_value split: prod.splits)

lemma abs_valid_operator_5':
  "wf_operator (name, pre, eff, cost) 
     list_all (λ(v, a). list_all (λ(v', a'). v  v'  a = a') pre) pre"
  apply(drule wf_operator_preD)
  by (intro consistent_list_set)

lemma abs_valid_operator_5[intro!]:
  "wf_operator op 
     list_all (λ(v, a). list_all (λ(v', a'). v  v'  a = a') (precondition_of (abs_ast_operator op)))
              (precondition_of (abs_ast_operator op))"
  using abs_valid_operator_5'
  by (cases op, simp add: abs_ast_operator_def)

lemma consistent_list_set_2: "distinct (map fst s) 
   list_all (λ(v, a). list_all (λ(v', a'). v  v'  a = a') s) s"
  by (auto simp add: list.pred_set wf_partial_state_def eq_key_imp_eq_value split: prod.splits)

lemma abs_valid_operator_6':
  assumes "wf_operator (name, pre, eff, cost)"
  shows "list_all (λ(v, a). list_all (λ(v', a'). v  v'  a = a') (map (λ(_, v, _, a). (v, a)) eff))
              (map (λ(_, v, _, a). (v, a)) eff)"
proof-
  have *: "map fst (map (λ(_, v, _, a). (v, a)) eff) = (map (λ(_, v,_,_). v) eff)"
    by (induction eff) auto
  show ?thesis
    using assms
    apply(elim wf_operator_effE)
    apply(intro consistent_list_set_2)
    by (subst *)
qed

lemma abs_valid_operator_6[intro!]:
  "wf_operator op  
     list_all (λ(v, a). list_all (λ(v', a'). v  v'  a = a') (effect_of (abs_ast_operator op)))
              (effect_of (abs_ast_operator op))"
  using abs_valid_operator_6'
  by (cases op, simp add: abs_ast_operator_def)

end

context ast_problem
begin

definition abs_ast_operator_section
  :: "nat_sas_plus_operator list" 
  where "abs_ast_operator_section  [abs_ast_operator op. op  astδ]" 

definition abs_prob :: "nat_sas_plus_problem"
  where "abs_prob =  
    variables_of = abs_ast_variable_section,
    operators_of = abs_ast_operator_section,
    initial_of = abs_ast_initial_state,
    goal_of = abs_ast_goal,
    range_of = abs_range_map
  " 

end

context abs_ast_prob
begin

lemma [simp]: "op  set astδ  (is_valid_operator_sas_plus abs_prob) (abs_ast_operator op)"
  apply(cases op)
  apply(subst is_valid_operator_sas_plus_def Let_def)+
  using wf_operators(2)
  by(fastforce simp add: abs_prob_def)+

lemma abs_ast_operator_section_valid: 
   "list_all (is_valid_operator_sas_plus abs_prob) abs_ast_operator_section"
  by (auto simp: abs_ast_operator_section_def list.pred_set)

lemma abs_prob_valid: "is_valid_problem_sas_plus abs_prob"
  using valid_abs_goal_1 valid_abs_goal_2 valid_abs_init_1 is_valid_vars_2
        abs_ast_operator_section_valid[unfolded abs_prob_def]
  by (auto simp add: is_valid_problem_sas_plus_def Let_def ListMem_iff abs_prob_def)

definition abs_ast_plan 
  :: " SASP_Semantics.plan  nat_sas_plus_plan"
  where "abs_ast_plan πs 
     map (abs_ast_operator o the o lookup_operator) πs" 

lemma std_then_implici_effs[simp]: "is_standard_operator' (name, pres, effs, layer)  implicit_pres effs = []"
  apply(induction effs)
  by (auto simp add: is_standard_operator'_def implicit_pres_def is_standard_effect'_def)

lemma [simp]: "enabled π s  lookup_operator π = Some (name, pres, effs, layer) 
       is_standard_operator' (name, pres, effs, layer) 
       (filter (eff_enabled s) effs) = effs"
  by(auto simp add: enabled_def is_standard_operator'_def eff_enabled_def is_standard_effect'_def filter_id_conv list.pred_set)
  
lemma effs_eq_abs_effs: "(effect_of (abs_ast_operator (name, pres, effs, layer))) = 
                           (map (λ(_,x,_,v). (x,v)) effs)"
  by (auto simp add: abs_ast_operator_def
           split: option.splits prod.splits)

lemma exect_eq_abs_execute:
      "enabled π s; lookup_operator π = Some (name, preconds, effs, layer);
        is_standard_operator'(name, preconds, effs, layer) 
       execute π s = (execute_operator_sas_plus s ((abs_ast_operator o the o lookup_operator) π))"
  using effs_eq_abs_effs
  by (auto simp add: execute_def execute_operator_sas_plus_def)

lemma enabled_then_sas_applicable:
  "enabled π s  SAS_Plus_Representation.is_operator_applicable_in s ((abs_ast_operator o the o lookup_operator) π)"
  by (auto simp add: subsuming_states_def enabled_def lookup_operator_def
                     SAS_Plus_Representation.is_operator_applicable_in_def abs_ast_operator_def                     
           split: option.splits prod.splits)

lemma path_to_then_exec_serial: "πset πs. lookup_operator π  None 
        path_to s πs s' 
        s' m execute_serial_plan_sas_plus s (abs_ast_plan πs)"
proof(induction πs arbitrary: s s')
  case (Cons a πs)
  then show ?case
    by (force simp: exect_eq_abs_execute abs_ast_plan_def lookup_Some_inδ no_cond_effs
              dest: enabled_then_sas_applicable)
qed (auto simp: execute_serial_plan_sas_plus_def abs_ast_plan_def)

lemma map_of_eq_None_iff:
  "(None = map_of xys x) = (x  fst ` (set xys))"
by (induct xys) simp_all

lemma [simp]: "I = abs_ast_initial_state"
  apply(intro HOL.ext)
  by (auto simp: map_of_eq_None_iff set_map[symmetric] I_def abs_ast_initial_state_def map_of_zip_Some
           dest: map_of_SomeD)

lemma [simp]: "π  set πs. lookup_operator π  None 
          opset (abs_ast_plan πs)  op  set abs_ast_operator_section"
  by (induction πs) (auto simp: abs_ast_plan_def abs_ast_operator_section_def lookup_Some_inδ)

end

context ast_problem
begin

lemma path_to_then_lookup_Some: "(s'G. path_to s πs s')  (π  set πs. lookup_operator π  None)"
  by (induction πs arbitrary: s) (force simp add: enabled_def split: option.splits)+

lemma valid_plan_then_lookup_Some: "valid_plan πs  (π  set πs. lookup_operator π  None)"
  using path_to_then_lookup_Some
  by(simp add: valid_plan_def)

end

context abs_ast_prob
begin

theorem valid_plan_then_is_serial_sol:
  assumes "valid_plan πs"
  shows "is_serial_solution_for_problem abs_prob (abs_ast_plan πs)"
  using valid_plan_then_lookup_Some[OF assms] assms
  by (auto simp add: is_serial_solution_for_problem_def valid_plan_def initial_of_def
                       abs_prob_def abs_ast_goal_def G_def subsuming_states_def list_all_iff
                       ListMem_iff map_le_trans path_to_then_exec_serial
           simp del: sas_plus_problem.select_defs)

end

subsection ‹Translating SAS+ represnetation to Fast-Downward's›

context ast_problem
begin

definition lookup_action:: "nat_sas_plus_operator  ast_operator option" where
 "lookup_action op 
    find (λ(_, pres, effs, _). precondition_of op = pres 
                               map (λ(v,a). ([], v, None, a)) (effect_of op) = effs)
         astδ"

end

context abs_ast_prob
begin

lemma find_Some: "find P xs = Some x  x  set xs  P x"
  by (auto simp add: find_Some_iff)

lemma distinct_find: "distinct (map f xs)  x  set xs  find (λx'. f x' = f x) xs = Some x"
  by (induction xs) (auto simp: image_def)

lemma lookup_operator_find: "lookup_operator nme = find (λop. fst op = nme) astδ"
  by (auto simp: lookup_operator_def intro!: arg_cong[where f = "(λx. find x astδ)"])

lemma lookup_operator_works_1: "lookup_action op = Some π'  lookup_operator (fst π') = Some π'"
  by (auto simp: wf_operators(1) lookup_operator_find lookup_action_def dest: find_Some intro: distinct_find)

lemma lookup_operator_works_2: 
  "lookup_action (abs_ast_operator (name, pres, effs, layer)) = Some (name', pres', effs', layer')
    pres = pres'"
  by (auto simp: lookup_action_def abs_ast_operator_def dest!: find_Some)

lemma [simp]: "is_standard_operator' (name, pres, effs, layer) 
       map (λ(v,a). ([], v, None, a)) (effect_of (abs_ast_operator (name, pres, effs, layer))) = effs"
  by (induction effs) (auto simp: is_standard_operator'_def  abs_ast_operator_def is_standard_effect'_def)

lemma lookup_operator_works_3:
  "is_standard_operator' (name, pres, effs, layer)  (name, pres, effs, layer)  set astδ 
   lookup_action (abs_ast_operator (name, pres, effs, layer)) = Some (name', pres', effs', layer')
    effs = effs'"
  by(auto simp: is_standard_operator'_def lookup_action_def dest!: find_Some)

lemma mem_find_Some: "x  set xs  P x  x'. find P xs = Some x'"
  by (induction xs) auto

lemma [simp]: "precondition_of (abs_ast_operator (x1, a, aa, b)) = a"
  by(simp add: abs_ast_operator_def)

lemma std_lookup_action: "is_standard_operator' ast_op  ast_op  set astδ  
                          ast_op'. lookup_action (abs_ast_operator ast_op) = Some ast_op'"
  unfolding lookup_action_def
  apply(intro mem_find_Some)
  by (auto split: prod.splits simp: o_def)

lemma is_applicable_then_enabled_1:
      "ast_op  set astδ 
       ast_op'. lookup_operator ((fst o the o lookup_action o abs_ast_operator) ast_op) = Some ast_op'"
  using lookup_operator_works_1 std_lookup_action no_cond_effs
  by auto

lemma lookup_action_Some_in_δ: "lookup_action op = Some ast_op  ast_op  set astδ"
  using lookup_operator_works_1 lookup_Some_inδ by fastforce

lemma lookup_operator_eq_name: "lookup_operator name = Some (name', pres, effs, layer)  name = name'"
  using lookup_operator_wf(2)
  by fastforce

lemma eq_name_eq_pres: "(name, pres, effs, layer)  set astδ  (name, pres', effs', layer')  set astδ
   pres = pres'"
  using  eq_key_imp_eq_value[OF wf_operators(1)]
  by auto

lemma eq_name_eq_effs: 
  "name = name'  (name, pres, effs, layer)  set astδ  (name', pres', effs', layer')  set astδ
   effs = effs'"
  using eq_key_imp_eq_value[OF wf_operators(1)]
  by auto

lemma is_applicable_then_subsumes:
      "s  valid_states  
       SAS_Plus_Representation.is_operator_applicable_in s (abs_ast_operator (name, pres, effs, layer)) 
       s  subsuming_states (map_of pres)"
  by (simp add: subsuming_states_def SAS_Plus_Representation.is_operator_applicable_in_def
                  abs_ast_operator_def)

lemma eq_name_eq_pres':
  "s  valid_states ; is_standard_operator' (name, pres, effs, layer); (name, pres, effs, layer)  set astδ ;
    lookup_operator ((fst o the o lookup_action o abs_ast_operator) (name, pres, effs, layer)) = Some (name', pres', effs', layer')
     pres = pres'"
  using lookup_operator_eq_name lookup_operator_works_2      
  by (fastforce dest!: std_lookup_action
                simp: eq_name_eq_pres[OF lookup_action_Some_in_δ lookup_Some_inδ])

lemma is_applicable_then_enabled_2:
  "s  valid_states ; ast_op  set astδ ;
    SAS_Plus_Representation.is_operator_applicable_in s (abs_ast_operator ast_op);
    lookup_operator ((fst o the o lookup_action o abs_ast_operator) ast_op) = Some (name, pres, effs, layer)
     ssubsuming_states (map_of pres)"
  apply(cases ast_op)
  using eq_name_eq_pres' is_applicable_then_subsumes no_cond_effs
  by fastforce
  
lemma is_applicable_then_enabled_3:
  "s  valid_states;
    lookup_operator ((fst o the o lookup_action o abs_ast_operator) ast_op) = Some (name, pres, effs, layer)
    ssubsuming_states (map_of (implicit_pres effs))"
  apply(cases ast_op)
  using no_cond_effs
  by (auto dest!: std_then_implici_effs std_lookup_action lookup_Some_inδ
           simp: subsuming_states_def)

lemma is_applicable_then_enabled:
 "s  valid_states; ast_op  set astδ;
   SAS_Plus_Representation.is_operator_applicable_in s (abs_ast_operator ast_op)
    enabled ((fst o the o lookup_action o abs_ast_operator) ast_op) s"
  using is_applicable_then_enabled_1 is_applicable_then_enabled_2 is_applicable_then_enabled_3
  by(simp add: enabled_def split: option.splits)

lemma eq_name_eq_effs':
  assumes "lookup_operator ((fst o the o lookup_action o abs_ast_operator) (name, pres, effs, layer)) =
             Some (name', pres', effs', layer')"
          "is_standard_operator' (name, pres, effs, layer)" "(name, pres, effs, layer)  set astδ"
          "s  valid_states"
  shows "effs = effs'"
  using std_lookup_action[OF assms(2,3)] assms
  by (auto simp: lookup_operator_works_3[OF assms(2,3)] 
                 eq_name_eq_effs[OF lookup_operator_eq_name lookup_action_Some_in_δ lookup_Some_inδ])

lemma std_eff_enabled'[simp]:
  "is_standard_operator' (name, pres, effs, layer)  s  valid_states  (filter (eff_enabled s) effs) = effs"
  by (induction effs) (auto simp: is_standard_operator'_def is_standard_effect'_def eff_enabled_def subsuming_states_def)

lemma execute_abs:
  "s  valid_states; ast_op  set astδ;
    SAS_Plus_Representation.is_operator_applicable_in s (abs_ast_operator ast_op) 
    execute ((fst o the o lookup_action o abs_ast_operator) ast_op) s =
      execute_operator_sas_plus s (abs_ast_operator ast_op)"
  using no_cond_effs
  by(cases ast_op)
    (fastforce simp add: execute_def execute_operator_sas_plus_def effs_eq_abs_effs
               dest: is_applicable_then_enabled_1 eq_name_eq_effs'[unfolded o_def]
               split: option.splits)+

fun sat_preconds_as where
  "sat_preconds_as s [] = True"
| "sat_preconds_as s (op#ops) = 
     (SAS_Plus_Representation.is_operator_applicable_in s op 
      sat_preconds_as (execute_operator_sas_plus s op) ops)"

lemma exec_serial_then_path_to':
  "s  valid_states;
   opset ops. ast_op set astδ. op = abs_ast_operator ast_op;
   (sat_preconds_as s ops) 
   path_to s (map (fst o the o lookup_action) ops) (execute_serial_plan_sas_plus s ops)"
proof(induction ops arbitrary: s)
  case (Cons a ops)
  then show ?case
    using execute_abs is_applicable_then_enabled execute_preserves_valid
    apply simp
    by metis
qed auto

end

fun rem_condless_ops where
  "rem_condless_ops s [] = []"
| "rem_condless_ops s (op#ops) = 
     (if SAS_Plus_Representation.is_operator_applicable_in s op then
      op # (rem_condless_ops (execute_operator_sas_plus s op) ops)
      else [])"

context abs_ast_prob
begin

lemma exec_rem_consdless: "execute_serial_plan_sas_plus s (rem_condless_ops s ops) = execute_serial_plan_sas_plus s ops"
  by (induction ops arbitrary: s) auto

lemma rem_conless_sat: "sat_preconds_as s (rem_condless_ops s ops)"
  by (induction ops arbitrary: s) auto

lemma set_rem_condlessD: "x  set (rem_condless_ops s ops)  x  set ops"
  by (induction ops arbitrary: s) auto

lemma exec_serial_then_path_to:
  "s  valid_states;
   opset ops. ast_op set astδ. op = abs_ast_operator ast_op 
   path_to s (((map (fst o the o lookup_action)) o rem_condless_ops s) ops)
             (execute_serial_plan_sas_plus s ops)"
  using  rem_conless_sat
  by (fastforce dest!: set_rem_condlessD
                intro!: exec_serial_then_path_to'
                          [where s = s and ops = "rem_condless_ops s ops",
                           unfolded exec_rem_consdless])

lemma is_serial_solution_then_abstracted:
  "is_serial_solution_for_problem abs_prob ops
    opset ops. ast_op set astδ. op = abs_ast_operator ast_op"
  by(auto simp: is_serial_solution_for_problem_def abs_prob_def Let_def list.pred_set
                    ListMem_iff abs_ast_operator_section_def
          split: if_splits)

lemma lookup_operator_works_1': "lookup_action op = Some π'  op. lookup_operator (fst π') = op"
  using lookup_operator_works_1 by auto

lemma is_serial_sol_then_valid_plan_1:
 "is_serial_solution_for_problem abs_prob ops;
   π  set ((map (fst o the o lookup_action) o rem_condless_ops I) ops) 
  lookup_operator π  None"
  using std_lookup_action lookup_operator_works_1 no_cond_effs
  by (fastforce dest!: set_rem_condlessD is_serial_solution_then_abstracted
                simp: valid_plan_def list.pred_set ListMem_iff)

lemma is_serial_sol_then_valid_plan_2:
 "is_serial_solution_for_problem abs_prob ops 
   (s'G. path_to I ((map (fst o the o lookup_action) o rem_condless_ops I) ops) s')"
  using I_valid
  by (fastforce intro: path_to_pres_valid exec_serial_then_path_to
                intro!: bexI[where x = "execute_serial_plan_sas_plus I ops"]
                dest: is_serial_solution_then_abstracted
                simp: list.pred_set ListMem_iff abs_ast_operator_section_def
                      G_def subsuming_states_def is_serial_solution_for_problem_def
                      abs_prob_def abs_ast_goal_def)+

end

context ast_problem
begin

definition "decode_abs_plan  (map (fst o the o lookup_action) o rem_condless_ops I)"

end

context abs_ast_prob
begin

theorem is_serial_sol_then_valid_plan:
  "is_serial_solution_for_problem abs_prob ops 
   valid_plan (decode_abs_plan ops)"
  using is_serial_sol_then_valid_plan_1 is_serial_sol_then_valid_plan_2
  by(simp add: valid_plan_def decode_abs_plan_def)

end

end

Theory Set2_Join_RBT

(*
  Author: Tobias Nipkow 
*)

(*
  Author: Mohammad Abdulaziz, copied it from src/HOL/Data_Structures to extend the global interpretation
*)
(*<*)
section "Join-Based Implementation of Sets via RBTs"

theory Set2_Join_RBT
imports
  "HOL-Data_Structures.Set2_Join"
  "HOL-Data_Structures.RBT_Set"
begin

subsection "Code"

text ‹
Function joinL› joins two trees (and an element).
Precondition: prop‹bheight l  bheight r.
Method:
Descend along the left spine of r›
until you find a subtree with the same bheight› as l›,
then combine them into a new red node.
›
fun joinL :: "'a rbt  'a  'a rbt  'a rbt" where
"joinL l x r =
  (if bheight l  bheight r then R l x r
   else case r of
     B l' x' r'  baliL (joinL l x l') x' r' |
     R l' x' r'  R (joinL l x l') x' r')"

fun joinR :: "'a rbt  'a  'a rbt  'a rbt" where
"joinR l x r =
  (if bheight l  bheight r then R l x r
   else case l of
     B l' x' r'  baliR l' x' (joinR r' x r) |
     R l' x' r'  R l' x' (joinR r' x r))"

definition join :: "'a rbt  'a  'a rbt  'a rbt" where
"join l x r =
  (if bheight l > bheight r
   then paint Black (joinR l x r)
   else if bheight l < bheight r
   then paint Black (joinL l x r)
   else B l x r)"

declare joinL.simps[simp del]
declare joinR.simps[simp del]


subsection "Properties"

subsubsection "Color and height invariants"

lemma invc2_joinL:
 " invc l; invc r; bheight l  bheight r  
  invc2 (joinL l x r)
   (bheight l  bheight r  color r = Black  invc(joinL l x r))"
proof (induct l x r rule: joinL.induct)
  case (1 l x r) thus ?case
    by(auto simp: invc_baliL invc2I joinL.simps[of l x r] split!: tree.splits if_splits)
qed

lemma invc2_joinR:
  " invc l; invh l; invc r; invh r; bheight l  bheight r  
  invc2 (joinR l x r)
   (bheight l  bheight r  color l = Black  invc(joinR l x r))"
proof (induct l x r rule: joinR.induct)
  case (1 l x r) thus ?case
    by(fastforce simp: invc_baliR invc2I joinR.simps[of l x r] split!: tree.splits if_splits)
qed

lemma bheight_joinL:
  " invh l; invh r; bheight l  bheight r   bheight (joinL l x r) = bheight r"
proof (induct l x r rule: joinL.induct)
  case (1 l x r) thus ?case
    by(auto simp: bheight_baliL joinL.simps[of l x r] split!: tree.split)
qed

lemma invh_joinL:
  " invh l;  invh r;  bheight l  bheight r   invh (joinL l x r)"
proof (induct l x r rule: joinL.induct)
  case (1 l x r) thus ?case
    by(auto simp: invh_baliL bheight_joinL joinL.simps[of l x r] split!: tree.split color.split)
qed

lemma bheight_baliR:
  "bheight l = bheight r  bheight (baliR l a r) = Suc (bheight l)"
by (cases "(l,a,r)" rule: baliR.cases) auto

lemma bheight_joinR:
  " invh l;  invh r;  bheight l  bheight r   bheight (joinR l x r) = bheight l"
proof (induct l x r rule: joinR.induct)
  case (1 l x r) thus ?case
    by(fastforce simp: bheight_baliR joinR.simps[of l x r] split!: tree.split)
qed

lemma invh_joinR:
  " invh l; invh r; bheight l  bheight r   invh (joinR l x r)"
proof (induct l x r rule: joinR.induct)
  case (1 l x r) thus ?case
    by(fastforce simp: invh_baliR bheight_joinR joinR.simps[of l x r]
        split!: tree.split color.split)
qed

(* unused *)
lemma rbt_join: " invc l; invh l; invc r; invh r   rbt(join l x r)"
by(simp add: invc2_joinL invc2_joinR invh_joinL invh_joinR invh_paint rbt_def
    color_paint_Black join_def)

text ‹To make sure the the black height is not increased unnecessarily:›

lemma bheight_paint_Black: "bheight(paint Black t)  bheight t + 1"
by(cases t) auto

lemma " rbt l; rbt r   bheight(join l x r)  max (bheight l) (bheight r) + 1"
using bheight_paint_Black[of "joinL l x r"] bheight_paint_Black[of "joinR l x r"]
  bheight_joinL[of l r x] bheight_joinR[of l r x]
by(auto simp: max_def rbt_def join_def)


subsubsection "Inorder properties"

text "Currently unused. Instead const‹set_tree› and const‹bst› properties are proved directly."

lemma inorder_joinL: "bheight l  bheight r  inorder(joinL l x r) = inorder l @ x # inorder r"
proof(induction l x r rule: joinL.induct)
  case (1 l x r)
  thus ?case by(auto simp: inorder_baliL joinL.simps[of l x r] split!: tree.splits color.splits)
qed

lemma inorder_joinR:
  "inorder(joinR l x r) = inorder l @ x # inorder r"
proof(induction l x r rule: joinR.induct)
  case (1 l x r)
  thus ?case by (force simp: inorder_baliR joinR.simps[of l x r] split!: tree.splits color.splits)
qed

lemma "inorder(join l x r) = inorder l @ x # inorder r"
by(auto simp: inorder_joinL inorder_joinR inorder_paint join_def
      split!: tree.splits color.splits if_splits
      dest!: arg_cong[where f = inorder])


subsubsection "Set and bst properties"

lemma set_baliL:
  "set_tree(baliL l a r) = set_tree l  {a}  set_tree r"
by(cases "(l,a,r)" rule: baliL.cases) (auto)

lemma set_joinL:
  "bheight l  bheight r  set_tree (joinL l x r) = set_tree l  {x}  set_tree r"
proof(induction l x r rule: joinL.induct)
  case (1 l x r)
  thus ?case by(auto simp: set_baliL joinL.simps[of l x r] split!: tree.splits color.splits)
qed

lemma set_baliR:
  "set_tree(baliR l a r) = set_tree l  {a}  set_tree r"
by(cases "(l,a,r)" rule: baliR.cases) (auto)

lemma set_joinR:
  "set_tree (joinR l x r) = set_tree l  {x}  set_tree r"
proof(induction l x r rule: joinR.induct)
  case (1 l x r)
  thus ?case by(force simp: set_baliR joinR.simps[of l x r] split!: tree.splits color.splits)
qed

lemma set_paint: "set_tree (paint c t) = set_tree t"
by (cases t) auto

lemma set_join: "set_tree (join l x r) = set_tree l  {x}  set_tree r"
by(simp add: set_joinL set_joinR set_paint join_def)

lemma bst_baliL:
  "bst l; bst r; xset_tree l. x < a; xset_tree r. a < x
    bst (baliL l a r)"
by(cases "(l,a,r)" rule: baliL.cases) (auto simp: ball_Un)

lemma bst_baliR:
  "bst l; bst r; xset_tree l. x < a; xset_tree r. a < x
    bst (baliR l a r)"
by(cases "(l,a,r)" rule: baliR.cases) (auto simp: ball_Un)

lemma bst_joinL:
  "bst (Node l (a, n) r); bheight l  bheight r
   bst (joinL l a r)"
proof(induction l a r rule: joinL.induct)
  case (1 l a r)
  thus ?case
    by(auto simp: set_baliL joinL.simps[of l a r] set_joinL ball_Un intro!: bst_baliL
        split!: tree.splits color.splits)
qed

lemma bst_joinR:
  "bst l; bst r; xset_tree l. x < a; yset_tree r. a < y 
   bst (joinR l a r)"
proof(induction l a r rule: joinR.induct)
  case (1 l a r)
  thus ?case
    by(auto simp: set_baliR joinR.simps[of l a r] set_joinR ball_Un intro!: bst_baliR
        split!: tree.splits color.splits)
qed

lemma bst_paint: "bst (paint c t) = bst t"
by(cases t) auto

lemma bst_join:
  "bst (Node l (a, n) r)  bst (join l a r)"
by(auto simp: bst_paint bst_joinL bst_joinR join_def)

lemma inv_join: " invc l; invh l; invc r; invh r   invc(join l x r)  invh(join l x r)"
by (simp add: invc2_joinL invc2_joinR invh_joinL invh_joinR invh_paint join_def)

subsubsection "Interpretation of locale‹Set2_Join› with Red-Black Tree"

global_interpretation RBT: Set2_Join
where join = join and inv = "λt. invc t  invh t"
defines insert_rbt = RBT.insert and delete_rbt = RBT.delete and split_rbt = RBT.split
and join2_rbt = RBT.join2 and split_min_rbt = RBT.split_min and inter_rbt = RBT.inter
proof (standard, goal_cases)
  case 1 show ?case by (rule set_join)
next
  case 2 thus ?case by (simp add: bst_join)
next
  case 3 show ?case by simp
next
  case 4 thus ?case by (simp add: inv_join)
next
  case 5 thus ?case by simp
qed

text ‹The invariant does not guarantee that the root node is black. This is not required
to guarantee that the height is logarithmic in the size --- Exercise.›

end

(*>*)

Theory Solve_SASP

(*
  Author: Mohammad Abdulaziz
*)

theory Solve_SASP
  imports AST_SAS_Plus_Equivalence "SAT_Solve_SAS_Plus" 
          "HOL-Data_Structures.RBT_Map" "HOL-Library.Code_Target_Nat" HOL.String
          AI_Planning_Languages_Semantics.SASP_Checker Set2_Join_RBT
begin

subsection ‹SAT encoding works for Fast-Downward's representation›

context abs_ast_prob
begin

theorem is_serial_sol_then_valid_plan_encoded:
  "𝒜  Φ (φ (prob_with_noop abs_prob)) t 
   valid_plan 
        (decode_abs_plan
           (rem_noops
                   (map (λop. φO¯ (prob_with_noop abs_prob) op)
                        (concat (Φ¯ (φ (prob_with_noop abs_prob)) 𝒜 t)))))"
  by (fastforce intro!: is_serial_sol_then_valid_plan abs_prob_valid
                        sas_plus_problem_has_serial_solution_iff_i')
  
lemma length_abs_ast_plan: "length πs = length (abs_ast_plan πs)"
  by (auto simp: abs_ast_plan_def)

theorem valid_plan_then_is_serial_sol_encoded:
  "valid_plan πs  length πs   h  𝒜. 𝒜  Φ (φ (prob_with_noop abs_prob)) h"
  apply(subst (asm) length_abs_ast_plan)
  by (fastforce intro!: sas_plus_problem_has_serial_solution_iff_ii' abs_prob_valid
                        valid_plan_then_is_serial_sol)
end

section ‹DIMACS-like semantics for CNF formulae›

text ‹We now push the SAT encoding towards a lower-level representation by replacing the atoms which
      have variable IDs and time steps into natural numbers.›

lemma gtD: "((l::nat) < n)  (m. n = Suc m  l  m)"
  by (induction n) auto

locale cnf_to_dimacs =
  fixes h :: nat and n_ops :: nat
begin

fun var_to_dimacs where
  "var_to_dimacs (Operator t k) = 1 + t + k * h"
| "var_to_dimacs (State t k) = 1 + n_ops * h + t + k * (h)"

definition dimacs_to_var where
  "dimacs_to_var v 
     if v < 1 + n_ops * h then
       Operator ((v - 1) mod (h)) ((v - 1) div (h))
     else
       (let k = ((v - 1) - n_ops * h) in 
          State (k mod (h)) (k div (h)))"

fun valid_state_var where
  "valid_state_var (Operator t k)  t < h  k < n_ops"
| "valid_state_var (State t k)  t < h"

lemma State_works:
"valid_state_var (State t k) 
      dimacs_to_var (var_to_dimacs (State t k)) = 
         (State t k)"
  by (induction k) (auto simp add: dimacs_to_var_def add.left_commute Let_def)

lemma Operator_works:
   "valid_state_var (Operator t k) 
      dimacs_to_var (var_to_dimacs (Operator t k)) = 
         (Operator t k)"
  by (induction k) (auto simp add: algebra_simps dimacs_to_var_def gr0_conv_Suc nat_le_iff_add dest!: gtD)

lemma sat_plan_to_dimacs_works:
  "valid_state_var sv 
     dimacs_to_var (var_to_dimacs sv) = sv"
  apply(cases sv)
  using State_works Operator_works
  by auto

end

lemma changing_atoms_works:
  "(x. P x  (f o g) x = x)  (xatoms phi. P x)  M  phi  M o f  map_formula g phi"  
  by (induction phi) auto  

lemma changing_atoms_works':
  "M o g  phi  M   map_formula g phi"  
  by (induction phi) auto  

context cnf_to_dimacs
begin

lemma sat_plan_to_dimacs:
  "(sv. svatoms sat_plan_formula  valid_state_var sv) 
       M  sat_plan_formula
          M o dimacs_to_var  map_formula var_to_dimacs sat_plan_formula"
  by(auto intro!: changing_atoms_works[where P = valid_state_var] simp: sat_plan_to_dimacs_works)

lemma dimacs_to_sat_plan:
  "M o var_to_dimacs  sat_plan_formula
      M  map_formula var_to_dimacs sat_plan_formula"
  using changing_atoms_works' .

end

locale sat_solve_sasp = abs_ast_prob "Π" + cnf_to_dimacs "Suc h" "Suc (length astδ)"
  for Π h
begin

lemma encode_initial_state_valid: 
  "sv  atoms (encode_initial_state Prob)  valid_state_var sv"
  by (auto simp add: encode_state_variable_def Let_def encode_initial_state_def split: sat_plan_variable.splits bool.splits)

lemma length_operators: "length (operators_of (φ (prob_with_noop abs_prob))) = Suc (length astδ)"
  by(simp add: abs_prob_def abs_ast_operator_section_def sas_plus_problem_to_strips_problem_def prob_with_noop_def)

lemma encode_operator_effect_valid_1: "t < h  op  set (operators_of (φ (prob_with_noop abs_prob)))  
       sv  atoms 
        ((map (λv. 
              ¬(Atom (Operator t (index (operators_of (φ (prob_with_noop abs_prob))) op)))
               Atom (State (Suc t) (index vs v))) 
            asses)) 
       valid_state_var sv"
  using length_operators
  by (induction asses) (auto simp: simp add: cnf_to_dimacs.valid_state_var.simps)
  
  
lemma encode_operator_effect_valid_2: "t < h  op  set (operators_of (φ (prob_with_noop abs_prob))) 
       sv  atoms 
        ((map (λv.
              ¬(Atom (Operator t (index (operators_of (φ (prob_with_noop abs_prob))) op)))
                ¬ (Atom (State (Suc t) (index vs v))))
            asses)) 
       valid_state_var sv"
  using length_operators
  by (induction asses) (auto simp: simp add: cnf_to_dimacs.valid_state_var.simps)

end

lemma atoms_And_append: "atoms ( (as1 @ as2)) = atoms ( as1)   atoms ( as2)"
  by (induction as1) auto

context sat_solve_sasp
begin

lemma encode_operator_effect_valid: 
  "sv  atoms (encode_operator_effect (φ (prob_with_noop abs_prob)) t op)  
    t < h  op  set (operators_of (φ (prob_with_noop abs_prob))) 
    valid_state_var sv"
  by (force simp: encode_operator_effect_def Let_def atoms_And_append 
            intro!: encode_operator_effect_valid_1 encode_operator_effect_valid_2)

end

lemma foldr_And: "foldr () as (¬ ) = ( as)"
  by (induction as) auto

context sat_solve_sasp
begin

lemma encode_all_operator_effects_valid:
   "t < Suc h 
    sv  atoms (encode_all_operator_effects (φ (prob_with_noop abs_prob)) (operators_of (φ (prob_with_noop abs_prob))) t)  
    valid_state_var sv"
  unfolding encode_all_operator_effects_def foldr_And 
  by (force simp add: encode_operator_effect_valid)

lemma encode_operator_precondition_valid_1: 
  "t < h  op  set (operators_of (φ (prob_with_noop abs_prob)))  
       sv  atoms 
        ((map (λv. 
        ¬ (Atom (Operator t (index (operators_of (φ (prob_with_noop abs_prob))) op)))  Atom (State t (f v))) 
      asses)) 
       valid_state_var sv"
  using length_operators
  by (induction asses) (auto simp: simp add: cnf_to_dimacs.valid_state_var.simps)
  
lemma encode_operator_precondition_valid: 
  "sv  atoms (encode_operator_precondition (φ (prob_with_noop abs_prob)) t op)  
    t < h  op  set (operators_of (φ (prob_with_noop abs_prob))) 
    valid_state_var sv"
  by (force simp: encode_operator_precondition_def Let_def 
            intro!: encode_operator_precondition_valid_1)

lemma encode_all_operator_preconditions_valid:
   "t < Suc h 
    sv  atoms (encode_all_operator_preconditions (φ (prob_with_noop abs_prob)) (operators_of (φ (prob_with_noop abs_prob))) t)  
    valid_state_var sv"
  unfolding encode_all_operator_preconditions_def foldr_And 
  by (force simp add: encode_operator_precondition_valid)

lemma encode_operators_valid:
   "sv  atoms (encode_operators (φ (prob_with_noop abs_prob)) t)  t < Suc h 
    valid_state_var sv" 
  unfolding encode_operators_def Let_def 
  by (force simp add: encode_all_operator_preconditions_valid encode_all_operator_effects_valid)

lemma encode_negative_transition_frame_axiom':
  "t < h 
   set deleting_operators  set (operators_of (φ (prob_with_noop abs_prob))) 
    sv  atoms 
       (¬(Atom (State t v_idx)) 
           (Atom (State (Suc t) v_idx)
            (map (λop. Atom (Operator t (index (operators_of (φ (prob_with_noop abs_prob))) op)))
          deleting_operators)))  
    valid_state_var sv"
  by (induction deleting_operators) (auto simp: length_operators[symmetric] cnf_to_dimacs.valid_state_var.simps)

lemma encode_negative_transition_frame_axiom_valid:
  "sv  atoms (encode_negative_transition_frame_axiom (φ (prob_with_noop abs_prob)) t v)   t < h  
    valid_state_var sv"
  unfolding encode_negative_transition_frame_axiom_def Let_def
  apply(intro encode_negative_transition_frame_axiom'[of t])
  by auto

lemma encode_positive_transition_frame_axiom_valid:
  "sv  atoms (encode_positive_transition_frame_axiom (φ (prob_with_noop abs_prob)) t v)  t < h  
    valid_state_var sv"
  unfolding encode_positive_transition_frame_axiom_def Let_def
  apply(intro encode_negative_transition_frame_axiom'[of t])
  by auto

lemma encode_all_frame_axioms_valid:
  "sv  atoms (encode_all_frame_axioms (φ (prob_with_noop abs_prob)) t)  t < Suc h 
    valid_state_var sv"
  unfolding encode_all_frame_axioms_def Let_def atoms_And_append
  by (force simp add: encode_negative_transition_frame_axiom_valid encode_positive_transition_frame_axiom_valid)

lemma encode_goal_state_valid: 
  "sv  atoms (encode_goal_state Prob t)  t < Suc h  valid_state_var sv"
  by (auto simp add: encode_state_variable_def Let_def encode_goal_state_def split: sat_plan_variable.splits bool.splits)

lemma encode_problem_valid:
  "sv  atoms (encode_problem (φ (prob_with_noop abs_prob)) h)  valid_state_var sv"
  unfolding encode_problem_def
  using encode_initial_state_valid encode_operators_valid encode_all_frame_axioms_valid encode_goal_state_valid
  by fastforce

lemma encode_interfering_operator_pair_exclusion_valid:
  "sv  atoms (encode_interfering_operator_pair_exclusion (φ (prob_with_noop abs_prob)) t op1 op2)  t < Suc h  
       op1  set (operators_of (φ (prob_with_noop abs_prob)))  op2  set (operators_of (φ (prob_with_noop abs_prob)))        
       valid_state_var sv"
  by (auto simp: encode_interfering_operator_pair_exclusion_def Let_def length_operators[symmetric] cnf_to_dimacs.valid_state_var.simps)

lemma encode_interfering_operator_exclusion_valid: 
  "sv  atoms (encode_interfering_operator_exclusion (φ (prob_with_noop abs_prob)) t)  t < Suc h  
      valid_state_var sv"
  unfolding encode_interfering_operator_exclusion_def Let_def foldr_And
  by (force simp add: encode_interfering_operator_pair_exclusion_valid)

lemma encode_problem_with_operator_interference_exclusion_valid:
  "sv  atoms (encode_problem_with_operator_interference_exclusion (φ (prob_with_noop abs_prob)) h)  valid_state_var sv"
  unfolding encode_problem_with_operator_interference_exclusion_def
  using encode_initial_state_valid encode_operators_valid encode_all_frame_axioms_valid encode_goal_state_valid
        encode_interfering_operator_exclusion_valid
  by fastforce

lemma planning_by_cnf_dimacs_complete:
  "valid_plan πs  length πs  h 
     M. M  map_formula var_to_dimacs (Φ (φ (prob_with_noop  abs_prob)) h)"
  using valid_plan_then_is_serial_sol_encoded
        sat_plan_to_dimacs[OF encode_problem_with_operator_interference_exclusion_valid]
  by meson

lemma planning_by_cnf_dimacs_sound:
  "𝒜  map_formula var_to_dimacs (Φ (φ (prob_with_noop abs_prob)) t) 
   valid_plan 
        (decode_abs_plan
           (rem_noops
             (map (λop. φO¯ (prob_with_noop abs_prob) op) 
                (concat (Φ¯ (φ (prob_with_noop abs_prob)) (𝒜 o var_to_dimacs) t)))))"
  using changing_atoms_works'
  by (fastforce intro!: is_serial_sol_then_valid_plan_encoded)

end

subsection ‹Going from Formualae to DIMACS-like CNF›

text ‹We now represent the CNF formulae into a very low-level representation that is reminiscent to
      the DIMACS representation, where a CNF formula is a list of list of integers.›

fun disj_to_dimacs::"nat formula  int list" where
  "disj_to_dimacs (φ1  φ2) = disj_to_dimacs φ1 @ disj_to_dimacs φ2"
| "disj_to_dimacs  = []"
| "disj_to_dimacs (Not ) = [-1::int,1::int]"
| "disj_to_dimacs (Atom v) = [int v]"
| "disj_to_dimacs (Not (Atom v)) = [-(int v)]"

fun cnf_to_dimacs::"nat formula  int list list" where
  "cnf_to_dimacs (φ1  φ2) = cnf_to_dimacs φ1 @ cnf_to_dimacs φ2"
| "cnf_to_dimacs d = [disj_to_dimacs d]"

definition "dimacs_lit_to_var l  nat (abs l)"

definition "find_max (xs::nat list) (fold max xs 1)"

lemma find_max_works:
"x  set xs  x  find_max xs" (is "?P  ?Q")
proof-
  have "x  set xs  (x::nat)  (fold max xs m)" for m
    unfolding max_def
    apply (induction xs arbitrary: m rule: rev_induct)
    using nat_le_linear
    by (auto dest:  le_trans simp add:)
  thus "?P  ?Q"
    by(auto simp add: find_max_def max_def)
qed

fun formula_vars where
"formula_vars () = []" |
"formula_vars (Atom k) = [k]" |
"formula_vars (Not F) = formula_vars F" |
"formula_vars (And F G) = formula_vars F @ formula_vars G" |
"formula_vars (Imp F G) = formula_vars F @ formula_vars G" |
"formula_vars (Or F G) = formula_vars F @ formula_vars G"

lemma atoms_formula_vars: "atoms f = set (formula_vars f)"
  by (induction f) auto

lemma max_var: "v  atoms (f::nat formula)  v  find_max (formula_vars f)"
  using find_max_works
  by(simp add: atoms_formula_vars)

definition "dimacs_max_var cs  find_max (map (find_max o (map (nat o abs))) cs)"

lemma fold_max_ge: "b  a  (b::nat)  fold (λx m. if m  x then x else m) ys a"
  by (induction ys arbitrary: a b) auto

lemma find_max_append:  "find_max (xs @ ys) = max (find_max xs) (find_max ys) "
  apply(simp only: Max.set_eq_fold[symmetric] append_Cons[symmetric] set_append find_max_def)
  by (metis List.finite_set Max.union Un_absorb Un_insert_left Un_insert_right list.distinct(1) list.simps(15) set_empty)

definition dimacs_model::"int list  int list list  bool" where
  "dimacs_model ls cs  (cset cs. (lset ls. l  set c)) 
                              distinct (map dimacs_lit_to_var ls)"

fun model_to_dimacs_model where
  "model_to_dimacs_model M (v#vs) = (if M v then int v else - (int v)) # (model_to_dimacs_model M vs)"
| "model_to_dimacs_model _ [] = []"

lemma model_to_dimacs_model_append:
 "set (model_to_dimacs_model M (vs @ vs')) = set (model_to_dimacs_model M vs)  set (model_to_dimacs_model M vs')"
  by (induction vs) auto

lemma upt_append_sing: "xs @ [x] = [a..<n_vars]  a < n_vars  (xs = [a..<n_vars - 1]  x = n_vars-1  n_vars > 0)"
  by (induction "n_vars") auto

lemma upt_eqD: "upt a b = upt a b'  (b = b'  b'  a  b  a)"
  by (induction b) (auto dest!: upt_append_sing split: if_splits)

lemma pos_in_model: "M n  0 < n  n < n_vars  int n  set (model_to_dimacs_model M [1..<n_vars])"
  by (induction n_vars) (auto simp add: less_Suc_eq model_to_dimacs_model_append )

lemma neg_in_model: "¬ M n  0 < n  n < n_vars  - (int n)  set (model_to_dimacs_model M [1..<n_vars])"
  by (induction n_vars) (auto simp add: less_Suc_eq model_to_dimacs_model_append)

lemma in_model: "0 < n  n < n_vars  int n  set (model_to_dimacs_model M [1..<n_vars])  - (int n)  set (model_to_dimacs_model M [1..<n_vars])"
  using pos_in_model neg_in_model
  by metis

lemma model_to_dimacs_model_all_vars:
  "(vatoms f. 0 < v  v < n_vars)  is_cnf f  M  f 
        (n<n_vars. 0 < n  (int n  set (model_to_dimacs_model M [(1::nat)..<n_vars]) 
                              -(int n)  set (model_to_dimacs_model M [(1::nat)..<n_vars])))"
  using in_model neg_in_model pos_in_model  
  by (auto simp add: le_less model_to_dimacs_model_append split: if_splits)

lemma cnf_And: "set (cnf_to_dimacs (f1  f2)) = set (cnf_to_dimacs f1)  set (cnf_to_dimacs f2)"
  by auto

lemma one_always_in:
  "1 < n_vars  1  set (model_to_dimacs_model M ([1..<n_vars]))  - 1  set (model_to_dimacs_model M ([1..<n_vars]))"
  by (induction n_vars) (auto simp add: less_Suc_eq model_to_dimacs_model_append)

lemma [simp]: "(disj_to_dimacs (f1  f2)) = (disj_to_dimacs f1) @ (disj_to_dimacs f2)"
  by auto

lemma [simp]: "(atoms (f1  f2)) = atoms f1  atoms f2"
  by auto

lemma isdisj_disjD: "(is_disj (f1  f2))  is_disj f1  is_disj f2"
  by (cases f1; auto)

lemma disj_to_dimacs_sound:
   "1 < n_vars  (vatoms f. 0 < v  v < n_vars)  is_disj f  M  f
      lset (model_to_dimacs_model M [(1::nat)..<n_vars]). l  set (disj_to_dimacs f)"
  apply(induction f)
  using neg_in_model pos_in_model one_always_in
  by (fastforce elim!: is_lit_plus.elims dest!: isdisj_disjD)+

lemma is_cnf_disj: "is_cnf (f1  f2)  (f. f1  f2 = f  is_disj f  P)  P"
  by auto

lemma cnf_to_dimacs_disj: "is_disj f  cnf_to_dimacs f = [disj_to_dimacs f]"
  by (induction f) auto

lemma model_to_dimacs_model_all_clauses:
  "1 < n_vars  (vatoms f. 0 < v  v < n_vars)  is_cnf f  M  f 
        cset (cnf_to_dimacs f)  lset (model_to_dimacs_model M [(1::nat)..<n_vars]). l  set c"
proof(induction f arbitrary: )
  case (Not f)
  then show ?case
    using in_model neg_in_model
    by (fastforce elim!: is_lit_plus.elims)+
next
  case (Or f1 f2)
  then show ?case
    using cnf_to_dimacs_disj disj_to_dimacs_sound
    by(elim is_cnf_disj, simp)
qed (insert in_model neg_in_model pos_in_model, auto)

lemma upt_eq_Cons_conv:
  "(x#xs = [i..<j]) = (i < j  i = x  [i+1..<j] = xs)"
  using upt_eq_Cons_conv
  by metis

lemma model_to_dimacs_model_append':
 "(model_to_dimacs_model M (vs @ vs')) = (model_to_dimacs_model M vs) @ (model_to_dimacs_model M vs')"
  by (induction vs) auto

lemma model_to_dimacs_neg_nin:
 "n_vars  x  int x  set (model_to_dimacs_model M [a..<n_vars])"
  by (induction n_vars arbitrary: a) (auto simp: model_to_dimacs_model_append')

lemma model_to_dimacs_pos_nin:
 "n_vars  x  - int x  set (model_to_dimacs_model M [a..<n_vars])"
  by (induction n_vars arbitrary: a) (auto simp: model_to_dimacs_model_append')

lemma int_cases2':
  "z  0  (n. 0  (int n)  z = int n  P)  (n. 0  - (int n)  z = - (int n)  P)  P"
  by (metis (full_types) int_cases2)

lemma model_to_dimacs_model_distinct:
  "1 < n_vars  distinct (map dimacs_lit_to_var (model_to_dimacs_model M [1..<n_vars]))"
  by (induction n_vars)
     (fastforce elim!: int_cases2'
                simp add: dimacs_lit_to_var_def model_to_dimacs_model_append'
                          model_to_dimacs_neg_nin model_to_dimacs_pos_nin)+

lemma model_to_dimacs_model_sound:
  "1 < n_vars  (vatoms f. 0 < v  v < n_vars)  is_cnf f  M  f 
        dimacs_model (model_to_dimacs_model M [(1::nat)..<n_vars]) (cnf_to_dimacs f)"
  unfolding dimacs_model_def
  using model_to_dimacs_model_all_vars model_to_dimacs_model_all_clauses model_to_dimacs_model_distinct
  by auto  

lemma model_to_dimacs_model_sound_exists:
  "1 < n_vars  (vatoms f. 0 < v  v < n_vars)  is_cnf f  M  f 
        M_dimacs. dimacs_model M_dimacs (cnf_to_dimacs f)"
  using model_to_dimacs_model_sound
  by metis

definition dimacs_to_atom ::"int  nat formula" where
  "dimacs_to_atom l  if (l < 0) then Not (Atom (nat (abs l))) else Atom (nat (abs l))"

definition dimacs_to_disj::"int list  nat formula" where
  "dimacs_to_disj f   (map dimacs_to_atom f)"

definition dimacs_to_cnf::"int list list  nat formula" where
  "dimacs_to_cnf f  map dimacs_to_disj f"

definition "dimacs_model_to_abs dimacs_M M  
  fold (λl M. if (l > 0) then M((nat (abs l)):= True) else M((nat (abs l)):= False)) dimacs_M M"

lemma dimacs_model_to_abs_atom:
  "0 < x  int x  set dimacs_M  distinct (map dimacs_lit_to_var  dimacs_M)  dimacs_model_to_abs dimacs_M M x"
proof (induction dimacs_M arbitrary: M rule: rev_induct)
  case (snoc a dimacs_M)
  thus ?case 
    by (auto simp add: dimacs_model_to_abs_def dimacs_lit_to_var_def image_def)
qed auto

lemma dimacs_model_to_abs_atom':
  "0 < x  -(int x)  set dimacs_M  distinct (map dimacs_lit_to_var  dimacs_M)  ¬ dimacs_model_to_abs dimacs_M M x"
proof (induction dimacs_M arbitrary: M rule: rev_induct)
  case (snoc a dimacs_M)
  thus ?case 
    by (auto simp add: dimacs_model_to_abs_def dimacs_lit_to_var_def image_def)
qed auto

lemma model_to_dimacs_model_complete_disj:
  "(vatoms f. 0 < v  v < n_vars)  is_disj f  distinct (map dimacs_lit_to_var dimacs_M)
      dimacs_model dimacs_M (cnf_to_dimacs f)  dimacs_model_to_abs dimacs_M (λ_. False)  f"
  by (induction f)
     (fastforce elim!: is_lit_plus.elims dest!: isdisj_disjD
                simp: cnf_to_dimacs_disj dimacs_model_def dimacs_model_to_abs_atom'
                      dimacs_model_to_abs_atom)+

lemma model_to_dimacs_model_complete:
  "(vatoms f. 0 < v  v < n_vars)  is_cnf f  distinct (map dimacs_lit_to_var dimacs_M)
      dimacs_model dimacs_M (cnf_to_dimacs f)  dimacs_model_to_abs dimacs_M (λ_. False)  f"
proof(induction f)
  case (Not f)
  then show ?case
    by (auto elim!: is_lit_plus.elims simp add: dimacs_model_to_abs_atom' dimacs_model_def)
next
  case (Or f1 f2)
  then show ?case
    using cnf_to_dimacs_disj model_to_dimacs_model_complete_disj
    by(elim is_cnf_disj, simp add: dimacs_model_def)
qed (insert dimacs_model_to_abs_atom, auto simp: dimacs_model_def)

lemma model_to_dimacs_model_complete_max_var:
  "(vatoms f. 0 < v)  is_cnf f  
   dimacs_model dimacs_M (cnf_to_dimacs f) 
     dimacs_model_to_abs dimacs_M (λ_. False)  f"
  using le_imp_less_Suc[OF max_var]
  by (auto intro!: model_to_dimacs_model_complete simp: dimacs_model_def)

lemma model_to_dimacs_model_sound_max_var:
  "(vatoms f. 0 < v)  is_cnf f  M  f 
     dimacs_model (model_to_dimacs_model M [(1::nat)..<(find_max (formula_vars f) + 2)])
                  (cnf_to_dimacs f)"
  using le_imp_less_Suc[unfolded Suc_eq_plus1, OF max_var]
  by (fastforce intro!: model_to_dimacs_model_sound)

context sat_solve_sasp
begin

lemma [simp]: "var_to_dimacs sv > 0"
  by(cases sv) auto

lemma var_to_dimacs_pos: 
  "v  atoms (map_formula var_to_dimacs f)  0 < v"
  by (induction f) auto

lemma map_is_disj: "is_disj f  is_disj (map_formula F f)"
  by (induction f) (auto elim: is_lit_plus.elims)

lemma map_is_cnf: "is_cnf f  is_cnf (map_formula F f)"
  by (induction f) (auto elim: is_lit_plus.elims simp: map_is_disj)

lemma planning_dimacs_complete:
  "valid_plan πs  length πs  h 
   let cnf_formula = (map_formula var_to_dimacs 
                                  (Φ (φ (prob_with_noop abs_prob)) h))
   in
       dimacs_M. dimacs_model dimacs_M (cnf_to_dimacs cnf_formula)"
  unfolding Let_def
  by (fastforce simp: var_to_dimacs_pos
                dest!: planning_by_cnf_dimacs_complete
                intro: model_to_dimacs_model_sound_max_var map_is_cnf
                       is_cnf_encode_problem_with_operator_interference_exclusion
                       is_valid_problem_sas_plus_then_strips_transformation_too
                       noops_valid abs_prob_valid)

lemma planning_dimacs_sound:
  "let cnf_formula =
     (map_formula var_to_dimacs
                  (Φ (φ (prob_with_noop abs_prob)) h))
   in
     dimacs_model dimacs_M (cnf_to_dimacs cnf_formula) 
   valid_plan 
        (decode_abs_plan
            (rem_noops
              (map (λop. φO¯ (prob_with_noop abs_prob) op)
                   (concat
                    (Φ¯ (φ (prob_with_noop abs_prob)) ((dimacs_model_to_abs dimacs_M (λ_. False)) o var_to_dimacs) h)))))"
  by(fastforce simp: var_to_dimacs_pos Let_def
               intro: planning_by_cnf_dimacs_sound model_to_dimacs_model_complete_max_var
                      map_is_cnf is_cnf_encode_problem_with_operator_interference_exclusion 
                      is_valid_problem_sas_plus_then_strips_transformation_too abs_prob_valid
                      noops_valid)

end

section ‹Code Generation›

text ‹We now generate SML code equivalent to the functions that encode a problem as a CNF formula
      and that decode the model of the given encodings into a plan.›

lemma [code]:
   "dimacs_model ls cs  (list_all (λc. list_ex (λl. ListMem l c ) ls) cs) 
                               distinct (map dimacs_lit_to_var ls)"
  unfolding dimacs_model_def
  by (auto simp: list.pred_set ListMem_iff list_ex_iff )

definition 
"SASP_to_DIMACS h prob 
   cnf_to_dimacs
     (map_formula 
       (cnf_to_dimacs.var_to_dimacs (Suc h) (Suc (length (ast_problem.astδ prob))))
         (Φ (φ (prob_with_noop (ast_problem.abs_prob prob))) h))"

lemma planning_dimacs_complete_code:
  "ast_problem.well_formed prob;
    πset (ast_problem.astδ prob). is_standard_operator' π;
    ast_problem.valid_plan prob πs;
    length πs  h 
   let cnf_formula = (SASP_to_DIMACS h prob) in
       dimacs_M. dimacs_model dimacs_M cnf_formula"
  unfolding SASP_to_DIMACS_def Let_def
  apply(rule sat_solve_sasp.planning_dimacs_complete[unfolded Let_def])
  apply unfold_locales
  by auto

definition "SASP_to_DIMACS' h prob  SASP_to_DIMACS h (rem_implicit_pres_ops prob)"

lemma planning_dimacs_complete_code':
  "ast_problem.well_formed prob;
    (op. op  set (ast_problem.astδ prob)  consistent_pres_op op);
    (op. op  set (ast_problem.astδ prob)  is_standard_operator op);
    ast_problem.valid_plan prob πs;
    length πs  h 
   let cnf_formula = (SASP_to_DIMACS' h prob) in
       dimacs_M. dimacs_model dimacs_M cnf_formula"
  unfolding Let_def SASP_to_DIMACS'_def
  by (auto simp add: rem_implicit_pres_ops_valid_plan[symmetric] wf_ast_problem_def
           simp del: rem_implicit_pres.simps
           intro!: rem_implicit_pres_is_standard_operator'
                   planning_dimacs_complete_code[unfolded Let_def]
                   rem_implicit_pres_ops_well_formed
           dest!: rem_implicit_pres_ops_inδD)

text ‹A function that does the checks required by the completeness theorem above, and returns
      appropriate error messages if any of the checks fail.›

definition
  "encode h prob 
     if ast_problem.well_formed prob then
       if (op  set (ast_problem.astδ prob). consistent_pres_op op) then
         if (op  set (ast_problem.astδ prob). is_standard_operator op) then
           Inl (SASP_to_DIMACS' h prob)
         else
           Inr (STR ''Error: Conditional effects!'')
       else
         Inr (STR ''Error: Preconditions inconsistent'')
     else
       Inr (STR ''Error: Problem malformed!'')"

lemma encode_sound:
  "ast_problem.valid_plan prob πs; length πs  h;
        encode h prob = Inl cnf_formula  
         (dimacs_M. dimacs_model dimacs_M cnf_formula)"
  unfolding encode_def
  by (auto split: if_splits simp: list.pred_set
           intro: planning_dimacs_complete_code'[unfolded Let_def])

lemma encode_complete:
  "encode h prob = Inr err  
     ¬(ast_problem.well_formed prob  (op  set (ast_problem.astδ prob). consistent_pres_op op) 
     (op  set (ast_problem.astδ prob). is_standard_operator op))"
  unfolding encode_def
  by (auto split: if_splits simp: list.pred_set
           intro: planning_dimacs_complete_code'[unfolded Let_def])

definition match_pre where
    "match_pre  λ(x,v) s. s x = Some v"
    
definition match_pres where 
    "match_pres pres s  preset pres. match_pre pre s"

lemma match_pres_distinct: 
  "distinct (map fst pres)  match_pres pres s  Map.map_of pres m s"
  unfolding match_pres_def match_pre_def 
  using map_le_def map_of_SomeD
  apply (auto split: prod.splits)
   apply fastforce
  using domI map_of_is_SomeI
  by smt

fun tree_map_of where
  "tree_map_of updatea T [] = T"
| "tree_map_of updatea T ((v,a)#m) = updatea v a (tree_map_of updatea T m)"

context Map
begin

abbreviation "tree_map_of'  tree_map_of update"

lemma tree_map_of_invar: "invar T  invar (tree_map_of' T pres)"
  by (induction pres) (auto simp add: invar_update)

lemma tree_map_of_works: "lookup (tree_map_of' empty pres) x = map_of pres x"
  by (induction pres) (auto simp: map_empty map_update[OF tree_map_of_invar[OF invar_empty]])

lemma tree_map_of_dom: "dom (lookup (tree_map_of' empty pres)) = dom (map_of pres)"
  by (induction pres) (auto simp: map_empty map_update[OF tree_map_of_invar[OF invar_empty]] tree_map_of_works)
end

lemma distinct_if_sorted: "sorted xs  distinct xs"
  by (induction xs rule: induct_list012) auto

context Map_by_Ordered
begin

lemma tree_map_of_distinct: "distinct (map fst (inorder (tree_map_of' empty pres)))"
  apply(induction pres) 
   apply(clarsimp simp: map_empty inorder_empty)
  using distinct_if_sorted invar_def invar_empty invar_update tree_map_of_invar
  by blast

end

lemma set_tree_intorder: "set_tree t = set (inorder t)"
  by (induction t) auto

lemma map_of_eq:
  "map_of xs = Map.map_of xs"
  by (induction xs) (auto simp: map_of_simps split: option.split)

lemma lookup_someD: "lookup T x = Some y  p. p  set (inorder T)  p = (x, y)"
  by (induction T) (auto split: if_splits)

lemma map_of_lookup: "sorted1 (inorder T)  Map.map_of (inorder T) = lookup T"
  apply(induction T)
   apply (auto split: prod.splits intro!: map_le_antisym
      simp: lookup_map_of map_add_Some_iff map_of_None2 sorted_wrt_append)
  using lookup_someD
  by (force simp: map_of_eq map_add_def map_le_def
            split: option.splits)+

lemma map_le_cong: "(x. m1 x = m2 x)  m1 m s  m2 m s"
  by presburger

lemma match_pres_submap:
  "match_pres (inorder (M.tree_map_of' empty pres)) s  Map.map_of pres m s"
  using match_pres_distinct[OF M.tree_map_of_distinct]
  by (smt M.invar_def M.invar_empty M.tree_map_of_invar M.tree_map_of_works map_le_cong map_of_eq map_of_lookup)  

lemma [code]:
  "SAS_Plus_Representation.is_operator_applicable_in s op  
      match_pres (inorder (M.tree_map_of' empty (SAS_Plus_Representation.precondition_of op))) s"
  by (simp add: match_pres_submap SAS_Plus_Representation.is_operator_applicable_in_def)

definition "decode_DIMACS_model dimacs_M h prob  
  (ast_problem.decode_abs_plan prob
      (rem_noops
         (map (λop. φO¯ (prob_with_noop (ast_problem.abs_prob prob)) op)
           (concat 
              (Φ¯ (φ (prob_with_noop (ast_problem.abs_prob prob)))
                   ((dimacs_model_to_abs dimacs_M (λ_. False)) o
                     (cnf_to_dimacs.var_to_dimacs (Suc h)
                        (Suc (length (ast_problem.astδ prob)))))
                   h)))))"

lemma planning_dimacs_sound_code:
  "ast_problem.well_formed prob;
    πset (ast_problem.astδ prob). is_standard_operator' π 
    let
      cnf_formula = (SASP_to_DIMACS h prob);
      decoded_plan = decode_DIMACS_model dimacs_M h prob
    in
     (dimacs_model dimacs_M cnf_formula  ast_problem.valid_plan prob decoded_plan)"
  unfolding SASP_to_DIMACS_def decode_DIMACS_model_def Let_def
  apply(rule impI sat_solve_sasp.planning_dimacs_sound[unfolded Let_def])+
  apply unfold_locales
  by auto

definition
  "decode_DIMACS_model' dimacs_M h prob  
     decode_DIMACS_model dimacs_M h (rem_implicit_pres_ops prob)"

lemma planning_dimacs_sound_code':
  "ast_problem.well_formed prob;
   (op. op  set (ast_problem.astδ prob)  consistent_pres_op op);
    πset (ast_problem.astδ prob). is_standard_operator π 
    let
      cnf_formula = (SASP_to_DIMACS' h prob);
      decoded_plan = decode_DIMACS_model' dimacs_M h prob
    in
     (dimacs_model dimacs_M cnf_formula  ast_problem.valid_plan prob decoded_plan)"
  unfolding SASP_to_DIMACS'_def decode_DIMACS_model'_def
  apply(subst rem_implicit_pres_ops_valid_plan[symmetric])
  by(fastforce simp only: rem_implicit_pres_ops_valid_plan wf_ast_problem_def
           intro!: rem_implicit_pres_is_standard_operator'
                   rem_implicit_pres_ops_well_formed
                   rev_iffD2[OF _ rem_implicit_pres_ops_valid_plan]
                   planning_dimacs_sound_code wf_ast_problem.intro
           dest!: rem_implicit_pres_ops_inδD)+

text ‹Checking if the model satisfies the formula takes the longest time in the decoding function.
      We reimplement that part using red black trees, which makes it 10 times faster, on average!›

fun list_to_rbt :: "int list  int rbt" where
  "list_to_rbt [] = Leaf"
| "list_to_rbt (x#xs) = insert_rbt x (list_to_rbt xs)"

lemma inv_list_to_rbt: "invc (list_to_rbt xs)  invh (list_to_rbt xs)"
  by (induction xs) (auto simp: rbt_def RBT.inv_insert)

lemma Tree2_list_to_rbt: "Tree2.bst (list_to_rbt xs)"
  by (induction xs) (auto simp: RBT.bst_insert)

lemma set_list_to_rbt: "Tree2.set_tree (list_to_rbt xs) = set xs"
  by (induction xs) (simp add: RBT.set_tree_insert Tree2_list_to_rbt)+

text ‹The following ›

lemma dimacs_model_code[code]:
  "dimacs_model ls cs  
        (let tls = list_to_rbt ls in
          (cset cs. size (inter_rbt (tls) (list_to_rbt c))  0) 
               distinct (map dimacs_lit_to_var ls))"
  using RBT.set_tree_inter[OF Tree2_list_to_rbt Tree2_list_to_rbt]
  apply (auto simp: dimacs_model_def Let_def set_list_to_rbt inter_rbt_def)
  apply (metis IntI RBT.set_empty empty_iff)
  by (metis Tree2.eq_set_tree_empty disjoint_iff_not_equal)

definition
  "decode M h prob 
     if ast_problem.well_formed prob then
       if (opset (ast_problem.astδ prob). consistent_pres_op op) then
         if (opset (ast_problem.astδ prob). is_standard_operator op) then
           if (dimacs_model M (SASP_to_DIMACS' h prob)) then
             Inl (decode_DIMACS_model' M h prob)
           else Inr (STR ''Error: Model does not solve the problem!'')
         else
           Inr (STR ''Error: Conditional effects!'')
       else
         Inr (STR ''Error: Preconditions inconsistent'')
     else
       Inr (STR ''Error: Problem malformed!'')"

lemma decode_sound:
  "decode M h prob = Inl plan  
         ast_problem.valid_plan prob plan"
  unfolding decode_def
  apply (auto split: if_splits simp: list.pred_set)
  using planning_dimacs_sound_code'
  by auto

lemma decode_complete:
  "decode M h prob = Inr err 
         ¬ (ast_problem.well_formed prob  
            (op  set (ast_problem.astδ prob). consistent_pres_op op) 
            (πset (ast_problem.astδ prob). is_standard_operator π)  
            dimacs_model M (SASP_to_DIMACS' h prob))"
  unfolding decode_def
  by (auto split: if_splits simp: list.pred_set)

lemma [code]:
  "ListMem x' []= False"
  "ListMem x' (x#xs) = (x' = x  ListMem x' xs)"
  by (simp add: ListMem_iff)+

lemmas [code] = SASP_to_DIMACS_def ast_problem.abs_prob_def
                ast_problem.abs_ast_variable_section_def ast_problem.abs_ast_operator_section_def
                ast_problem.abs_ast_initial_state_def ast_problem.abs_range_map_def
                ast_problem.abs_ast_goal_def cnf_to_dimacs.var_to_dimacs.simps
                ast_problem.astδ_def ast_problem.astDom_def ast_problem.abs_ast_operator_def
                ast_problem.astI_def ast_problem.astG_def ast_problem.lookup_action_def
                ast_problem.I_def execute_operator_sas_plus_def ast_problem.decode_abs_plan_def

definition nat_opt_of_integer :: "integer  nat option" where
       "nat_opt_of_integer i = (if (i  0) then Some (nat_of_integer i) else None)"

definition max_var :: "int list  int" where
       "max_var xs  fold (λ(x::int) (y::int). if abs x  abs y then (abs x) else y) xs (0::int)"

export_code encode nat_of_integer integer_of_nat nat_opt_of_integer Inl Inr String.explode
    String.implode max_var concat char_of_nat Int.nat integer_of_int length int_of_integer
  in SML module_name exported file_prefix SASP_to_DIMACS

export_code decode nat_of_integer integer_of_nat nat_opt_of_integer Inl Inr String.explode
    String.implode max_var concat char_of_nat Int.nat integer_of_int length int_of_integer
  in SML module_name exported file_prefix decode_DIMACS_model

end